unit PubUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls, ToolWin, ExtCtrls, MPlayer, Menus,MMSystem,
  Registry,Winsock,ShellAPI,DBGrids;


//=====================================================================================================================

    function GetMaxInTwo(CanShu01,CanShu02:Double):Double; 

    function GetMinInTwo(CanShu01,CanShu02:Double):Double; 

    function GetWindowsDirectory():String; 

    function GetApplicationDirectory():String; 

    function SetODBCConfig(DateFilePath,ODBCName:String):Boolean; 

    function GetDiskFree(DiskName:Byte):String; 

    function GetDiskSize(DiskName:Byte):String; 

    function GetRoundInt(CustomDouble:Double):Double; 

    function SetDoubleFormat(CustomDouble:Double;XiaoShuWei:Integer):Double; //自定義小數(shù)位

    function GetHostIP():TStrings;  //獲取本主機(jī)的IP地址

    function GetUserName():AnsiString; //取得用戶名稱

    function GetWindowsProductID(): string; // 取得 Windows 產(chǎn)品序號(hào)


//=====================================================================================================================

    procedure ErrorMsgBox();  //全程異常錯(cuò)誤消息過程

    procedure SetButtonCaptionAToB(CustomButton:TButton;AString,BString:String); 

    procedure SetFormPicture(CustomForm:TForm;PictureFile:String); //設(shè)置窗口的背景圖像

    procedure SetDBGridPicture(CustomDBGrid:TDBGrid;PictureFile:String); //設(shè)置窗口的背景圖像

    procedure SetCDRomOpen(); 

    procedure SetCDromClose(); 

    procedure SetWaveLeft(Volume:Integer);  
    procedure SetWaveRigth(Volume:Integer);  

    procedure SetWaveBalance(Volume:Integer);

    procedure SetWindowsReboot();  
    procedure SetWindowsClose();  

    procedure IsEditNumber(CustomEdit:TEdit);  

    procedure IsEditEmpty(CustomEdit:TEdit); 

    procedure SetTextXuanZhuan(OutForm:TForm;FontName,FontCaption:String;FontSize,FontOutTop,FontOutLeft,
                               FontOutJiaoDu:Integer;FontColor:TColor);  //設(shè)置輸出字體的旋轉(zhuǎn)效果

    procedure SetWallPicture(BmpFileName:String);  

    procedure SetFormRounder(CustomForm:TForm;FormLeft,FormTop,FormWidth,
                                              FormHeight,LeftHuDu,RightHuDu:Integer); //園腳窗口

    procedure SetTaskBarHide(); 

    procedure SetTaskBarShow(); 

    procedure SetPicture90(YuanImage,GuoImage:TImage); 

    procedure SetPicture180(YuanImage,GuoImage:TImage);  //旋轉(zhuǎn)圖像180 度

    procedure SetPicture270(YuanImage,GuoImage:TImage); // 旋轉(zhuǎn)圖像270 度

    procedure ExecuteExeApp(CustomExeName,CustomFileName:String); //運(yùn)行外部應(yīng)用程序

    procedure SetApplicationHide(); 

    procedure SetSystemMenu(CustomForm:TForm;MenuName:String); 

    procedure CopyFileDirectory(Handle:THandle;OldDirectory,NewDirectory:String);//拷貝整個(gè)目錄

    procedure DeleteFileDirectory(Handle:THandle;OldDirectory:String);//刪除整個(gè)目錄


//=====================================================================================================================

  Function LeftStr(inString : String; numChars : integer) : String;

  Function RightStr(inString : String; numChars : integer) : String;

  Function LTrim(inString : String) : String;

  Function RTrim(inString : String) : String;

  Function SubStr(inString : String; numChars, strSize : integer) : String;

  Function InStr(Text, Pattern : String) : Integer;

  function GetSecondFromString(TimeStr: string): dword;

  function GetFrameFromString(TimeStr: string): dword;

  function GetStringFromFrame(frames: dword): string;

  function ChInStr(str: string): boolean;

  function IsDigit(str: string): boolean;

const
   FPS = 25;  //for PAL, 30 frames per second
   

implementation

Function LeftStr;
Begin
  Result := Copy(inString,1,numChars)
End;

Function RightStr;
Var
  index: integer;
Begin
  If numChars >= Length(inString) Then
    RightStr := inString
  Else
    Begin
      index := Length(inString) - numChars+1;
      RightStr := Copy(inString,index,numChars)
    End
End;

Function LTrim;
Var
  p : Integer;
Begin
  if Length(inString)<1 then exit;

  p := 1;
  While (inString[p] = ' ') and (p <= Length(inString)) Do
    inc( p );
  If p > 1 Then
    Begin
      Move(inString[p], inString[1], Succ(Length(inString)) - p);
//      dec(inString[0], pred(p));
      SetLength(inString, Length(inString)-p+1);
    End;
   LTrim := inString;
End;

Function RTrim;
Begin
  While inString[Length(inString)-1] = ' ' Do
    //dec( inString[0] );
    SetLength(inString, Length(inString)-1);
  RTrim := inString;
End;

Function SubStr;
Begin
  SubStr := Copy(inString, numChars, StrSize );
End;

Function InStr;
Begin
  InStr := Pos( Pattern, Text );
End;

function GetFrameFromString(TimeStr: string): dword;
//get dword of frames from 00:00:00.00
var
   hour1,minute1,second1,frame1: dword;
   s1: string;
   i: integer;
begin
     i := InStr(TimeStr,':');
     hour1 := StrToInt(LeftStr(TimeStr, i-1));
     s1 := RightStr(TimeStr, Length(TimeStr)-i);  //00:00.00
     minute1 := StrToInt(LeftStr(s1, 2));
     s1 := RightStr(s1, Length(s1)-3);  //00.00
     second1 := StrToInt(LeftStr(s1, 2));
     s1 := RightStr(s1, Length(s1)-3);  //00
     frame1 := StrToInt(s1);

     Result := DWORD(DWORD(hour1)*3600 + DWORD(minute1)*60 + DWORD(second1)) //second
              *FPS + frame1;
end;

function GetSecondFromString(TimeStr: string): dword;
//get dword of frames from 00:00:00
var
   hour1,minute1,second1: dword;
   s1: string;
   i :integer;
begin
     i := InStr(TimeStr,':');
     hour1 := StrToInt(LeftStr(TimeStr, i-1));
     s1 := RightStr(TimeStr, Length(TimeStr)-i);  //00:00.00
     minute1 := StrToInt(LeftStr(s1, 2));
     s1 := RightStr(s1, Length(s1)-3);  //00.00
     second1 := StrToInt(LeftStr(s1, 2));

     Result := DWORD(DWORD(hour1)*3600 + DWORD(minute1)*60 + DWORD(second1));
end;

function GetStringFromFrame(frames: dword): string;
var
   ttt: dword;
   frameStr,hourStr,minuteStr,secondStr: string;
begin
     ttt := frames mod FPS;
     frameStr := IntToStr(ttt);
     if Length(frameStr)<2 then frameStr := '0'+frameStr;

     ttt := (frames div FPS) mod 60;
     secondStr := IntToStr(ttt);
     if Length(secondStr)<2 then secondStr := '0'+secondStr;

     ttt := ((frames div FPS) div 60) mod 60;
     minuteStr := IntToStr(ttt);
     if Length(minuteStr)<2 then minuteStr := '0'+minuteStr;

     ttt := (frames div FPS) div 3600;
     hourStr := IntToStr(ttt);
     if Length(hourStr)<2 then hourStr := '0'+hourStr;

     Result := hourStr+':'+minuteStr+':'+secondStr+'.'+frameStr;
end;

function ChInStr(str: string): boolean;
var
  i: integer;
begin
    Result := False;
    for i:=1 to Length(str) do
    begin
       if ((str[i]<='Z') and (str[i]>='A'))
        or ((str[i]<='z') and (str[i]>='a'))
        or ((str[i]<='9') and (str[i]>='0'))
        or (str[i]='~')
        or (str[i]='_')
        or (str[i]='.')
       then continue
       else begin
          Result := True;
          break;
       end;
    end;
end;

function IsDigit(str: string): boolean;
var
   i: integer;
begin
    Result := True;
    for i:=1 to Length(str) do
    begin
       if (str[i]>'9') or (str[i]<'0') then
       begin
          Result := False;
          break;
       end;
    end;
end;


function GetMaxInTwo(CanShu01,CanShu02:Double):Double; //判斷兩個(gè)整數(shù)大小返回大值
begin
        if CanShu01 > CanShu02 then
                Result:=CanShu01
             else
                Result:=CanShu02;
end;  {判斷兩各整數(shù)大小返回大值}


function GetMinInTwo(CanShu01,CanShu02:Double):Double; //判斷兩個(gè)整數(shù)大小返回小值
begin
             if CanShu01 < CanShu02 then
                Result:=CanShu01
             else
                Result:=CanShu02;
end;  {判斷兩各整數(shù)大小返回小值}


function GetWindowsDirectory():String; //返回Windows 的啟動(dòng)路徑
var
    WinBoot:string;
begin
    try
            SetLength(WinBoot,256);
            Windows.GetWindowsDirectory(PChar(WinBoot),256);
            SetLength(WinBoot,StrLen(PChar(WinBoot)));
            Result:=WinBoot;
     except
           PubUnit.ErrorMsgBox;
     end;
end;


function GetApplicationDirectory():String;  //返回應(yīng)用程序EXE文件的啟動(dòng)目錄
begin
     try
             Result:=ExtractFilePath(Application.ExeName);
     except
           PubUnit.ErrorMsgBox;
     end;
end;

function SetODBCConfig(DateFilePath,ODBCName:String):Boolean; //動(dòng)態(tài)配置ODBC(Access97,2000)
var
    RegisterTemp:TRegistry;
    bData : Array[0..0] of byte;
begin
     RegisterTemp:=TRegistry.Create;
with registerTemp do
     begin
          RootKey:=HKEY_LOCAL_MACHINE;//設(shè)置根鍵值為HKEY_LOCAL_MACHINE

         if OpenKey('Software\ODBC\ODBC.INI\ODBC Data Sources',True) then
             begin //注冊(cè)一個(gè)DSN名稱
                 WriteString(ODBCName,'Microsoft Access Driver (*.mdb)');
             end
         else
             begin//創(chuàng)建鍵值失敗
                 Application.MessageBox('增加ODBC數(shù)據(jù)源失敗','提示信息',0+48);
                 Result:=False;
                 exit;
             end;
                 CloseKey;

          if OpenKey('Software\ODBC\ODBC.INI\'+ODBCName,True) then
             begin
                WriteString('DBQ',DateFilePath);//數(shù)據(jù)庫目錄
                WriteString('Description',ODBCName);//數(shù)據(jù)源描述
                WriteString('Driver',GetWindowsDirectory()+'\System\Odbcjt32.dll');//驅(qū)動(dòng)程序DLL文件
                WriteInteger('DriverId', 25 );//驅(qū)動(dòng)程序標(biāo)識(shí)
                WriteString('FIL',ODBCName);//Filter依據(jù)
                WriteInteger('SafeTransaction',0);//支持的事務(wù)操作數(shù)目
                WriteString('UID','admin');//用戶名稱
                bData[0] := 0;
                WriteBinaryData('Exclusive',bData,1);//非獨(dú)占方式
                WriteBinaryData('ReadOnly',bData,1);//非只讀方式
             end
         else//創(chuàng)建鍵值失敗
                begin
                        Application.MessageBox('增加ODBC數(shù)據(jù)源失敗','提示信息',0+48);
                        Result:=False;
                exit;
                end;

                CloseKey;

        //寫入DSN數(shù)據(jù)庫引擎配置信息
        if OpenKey('Software\ODBC\ODBC.INI\'+ODBCName+'\Engines\Jet',True) then
                begin
                        WriteString('ImplicitCommitSync','Yes');
                        WriteInteger('MaxBufferSize',512);//緩沖區(qū)大小
                        WriteInteger('PageTimeout',10);//頁超時(shí)
                        WriteInteger('Threads',3);//支持的線程數(shù)目
                        WriteString('UserCommitSync','Yes');
                end
        else//創(chuàng)建鍵值失敗
                begin
                        Application.MessageBox('增加ODBC數(shù)據(jù)源失敗','提示信息',0+48);
                        Result:=False;
                        exit;
                end;

        CloseKey;
        Result:=True;
    Free;
end;

end;

function GetDiskFree(DiskName:Byte):String; //判斷磁盤剩余空間
var
       Temp:Double;
begin
       Temp:=DiskFree(DiskName)/1024/1024;
       if Temp < 0 then
          Application.MessageBox('您輸入了無效的盤符代號(hào),1:A 2:B 3:C','提示信息',0+48)
          else
          Result:=FloatToStr(Temp)+'兆';
end;

function GetDiskSize(DiskName:Byte):String; //判斷磁盤總空間
var
       Temp:Double;
begin
       Temp:=DiskSize(DiskName)/1024/1024;
       if Temp < 0 then
          Application.MessageBox('您輸入了無效的盤符代號(hào),1:A 2:B 3:C','提示信息',0+48)
          else
          Result:=FloatToStr(Temp)+'兆';
end;

function GetRoundInt(CustomDouble:Double):Double; //得到四舍五入結(jié)果
var
    Temp:Double;
begin
    Temp:=Int(CustomDouble);
    Temp:=Temp+1;
    Temp:=Temp-CustomDouble;
    if Temp >0.5 then
           Result:=Int(CustomDouble)
       else
           Result:=Int(CustomDouble+1);
end;   //四舍五入取得證數(shù)結(jié)果

function SetDoubleFormat(CustomDouble:Double;XiaoShuWei:Integer):Double; //自定義小數(shù)位