utchpublicfun.pas

delphi底层函数delphi底层函数delphi底层函数delphi底层函数

    else
      S[M] := '1';
    NewPath(S);
    if Ok = False then
      break;
  until Sizes >= Size;
  _lClose(G);
  Result := Ss;
end;
///////////////////////////////////////////////////////////////////////////todo:
//语法：ExpandFile(var Path: String; S, D: String; Size: LongInt);
//说明：
//参数：Path
//参数：S
//参数：D
//参数：Size
//该函数调用了CombinFile函数。
procedure ExpandFile(var Path: String; S, D: String; Size: LongInt);
var
  Src, Dst: Array[0..160] of char;
  Os, Ds: TOFStruct;
  Ss, Dd: Integer;
begin
  S := CombineFile(Path, S, Size);
  StrpCopy(Dst, D);
  Dd := LZOpenFile(Dst, Ds, OF_WRITE or OF_CREATE);
  StrpCopy(Src, S);
  Ss := LZopenFile(Src, Os, OF_READ);
  LZCopy(Ss, Dd);
  LZClose(Ss);
  LZClose(Dd);
end;
/////////////////////////////////////////////////////////////////////// todo:
//语法：CutFileIntoPath(Dn, NewPath: String; Apart: LongInt): String;
//说明：
//参数：Dn
//参数：NewPath
//参数：Apart
//该函数调用了CopyToFile函数。
function CutFileIntoPath(Dn, NewPath: String; Apart: LongInt): String;
var
  F, G, H: File;
  NewName: String;
  I, Rr: Integer;
  Keep: LongInt;
  Buf: Array[0..2048] of byte;
begin
  for I := Length(Dn) downto 1 do
  begin
    if Dn[I] = '\' then
      break;
  end;
  NewName := NewPath + Copy(Dn, I, 65535);
  I := Length(NewName);
  if NewName[I] in ['1'..'8'] then
    NewName[I] := Chr(Ord(NewName[I]) + 1)
  else
    NewName[I] := '1';
  ShowMessage('Starting Copy...');
  CopyToFile(Dn, 'c:\SCSTEMP');
  ShowMessage('Copy OK!');
  AssignFile(F, 'C:\SCSTEMP');
  AssignFile(G, NewName);
  AssignFile(H, Dn);
{$I-}
  Reset(F, 1);
{$I+}
  if ioResult <> 0 then
  begin
    ShowMessage('源文件{' + Dn + '}打开错误！');
    Exit;
  end;
{$I-}
  Rewrite(G, 1);
{$I+}
  if ioResult <> 0 then
  begin
    ShowMessage('目标文件{' + NewName + '}创建错误！');
    Exit;
  end;
{$I-}
  Rewrite(H, 1);
{$I+}
  if ioResult <> 0 then
  begin
    ShowMessage('源文件{' + dn + '}不能被创建！');
    Exit;
  end;
  Keep := FileSize(F) - Apart;
  repeat
    BlockRead(F, Buf, 2048, Rr);
    if FileSize(H) + Rr > Keep then
      Rr := Keep - FileSize(H);
    BlockWrite(H, Buf, Rr);
  until FileSize(H) >= Keep;
  CloseFile(H);
  Seek(F, Keep);
  repeat
    Blockread(F, Buf, 2048, Rr);
    BlockWrite(G, Buf, Rr);
  until Rr = 0;
  CloseFile(F);
  CloseFile(G);
  Result := NewName;
end;

//////////////////////////////////////////////////////////////////////////
//语法：CopyToFile(S, D: String);
//说明：拷贝文件。
//参数：S     源文件名
//参数：D     目标文件名
procedure CopyToFile(S, D: String);
var
  F, G: HFile;
  Rr: Integer;
  Buf: Array[0..2048] of byte;
begin
  F := _lOpen(Pchar(S), OF_READ);
  G := _lCreat(Pchar(D), 0);
  repeat
    Rr := _lRead(F, @Buf, 2048);
    _lWrite(G, @Buf, Rr);
  until Rr = 0;
  _lClose(G);
  _lClose(F);
end;
/////////////////////////////////////////////////////////////////////////////
//语法：GetApplicationVersion(FileName: String): String;
//说明：获得指定文件的版本号。
//参数：FileName
function GetApplicationVersion(FileName: String): String;
var
  InfoSize, Wnd: DWORD;
  VerBuf: Pointer;
  VerInfo: ^VS_FIXEDFILEINFO;
begin
  Result := '0.0.0.0';
  InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
  if InfoSize <> 0 then
  begin
    GetMem(VerBuf, InfoSize);
    try
      if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
      begin
        VerInfo := nil;
        VerQueryValue(VerBuf, '\', Pointer(VerInfo), Wnd);
        if VerInfo <> nil then
          Result := Format('%d.%d.%d.%d', [VerInfo^.dwFileVersionMS shr 16,
            VerInfo^.dwFileVersionMS and $0000FFFF,VerInfo^.dwFileVersionLS shr 16,
              VerInfo^.dwFileVersionLS and $0000FFFF]);
      end;
    finally
      FreeMem(VerBuf, InfoSize);
    end;
  end;
end;
///////////////////////////////////////////////////////////////////////
//语法：GetFileLastAccessTime(sFileName: String): String;
//说明：获得文件的最后修改日期。
//参数：sFileName
function GetFileLastAccessTime(sFileName: String): String;
begin
  if not fileexists(sFileName) then
  begin
    ShowMessage('文件不存在：' + sFileName);
    Result := '';
    Exit;
  end;
  Result := FormatDateTime('yyyy-mm-dd hh:nn:ss',
    FileDateToDateTime(FileAge(sFileName)));
end;

//////////////////////////////////////////////////////////////////////
//语法：GetFileIcon(const Filename: String; SmallIcon: Boolean): HIcon;
//说明：获得文件的图标。
//参数：FileName
//参数：SmallIcon
function GetFileIcon(const Filename: String; SmallIcon: Boolean): HIcon;
var
  Info: TSHFILEINFO;
  Flag: Integer;
begin
  if SmallIcon then
    Flag := (SHGFI_SMALLICON or SHGFI_ICON)
  else
    Flag := (SHGFI_LARGEICON or SHGFI_ICON);
  SHGetFileInfo(Pchar(Filename), 0, Info, Sizeof(Info), Flag);
  Result := Info.hIcon;
end;

////////////////////////////////////////////////////////////////////
//语法：GetTempDirectory: String;
//说明：返回临时目录路径。
//参数：
//执行内容：
function GetTempDirectory: String;
var
  Buf: PChar;
begin
  GetMem(Buf, MAX_PATH);   //Buf := StrAlloc(MAX_PATH);
  GetTempPath(MAX_PATH, buf);
  Result := StrPas(Buf);
  FreeMem(Buf);           //StrDispose(Buf);
end;
//////////////////////////////////////////////////////////////////
//语法：GetWinDirectory: String;
//说明：获取Windows安装路径。如：C:\WINNT
//参数：
function GetWinDirectory: String;
var
  sTemp: pChar;
begin
  sTemp := StrAlloc(MAX_PATH - 1);
  GetWindowsDirectory(sTemp, MAX_PATH - 1);
  Result := sTemp;
  StrDispose(sTemp);
end;
/////////////////////////////////////////////////////
//语法：GetSystemDirectory: String;
//说明：获取系统的路径。如C:\WINNT\SYSTEM32
//参数：
function GetSysDirectory: String;
var
  sTemp: pChar;
begin
  sTemp := StrAlloc(MAX_PATH - 1);
  GetSystemDirectory(sTemp,MAX_PATH - 1);
  Result := sTemp;
  StrDispose(sTemp);
end;
//////////////////////////////////////////////////////////////
//语法：Getmac
//说明：获得网卡的物理地址。
//参数：
function Getmac: String;
type
  PASTAT = ^TASTAT;
  TASTAT = record
    Adapter: TAdapterStatus;
    Name_Buf: TNameBuffer;
  end;

var
  Ncb: TNcb;
  S: String;
  Adapt: TASTAT;
  Lanaenum: TLanaenum;
  I, J, M: Integer;
  Strpart, StrMac: String;
begin
  FillChar(Ncb, SizeOf(TNcb), 0);
  Ncb.Ncb_Command := Char(NcbEnum);
  Ncb.Ncb_Buffer := PChar(@Lanaenum);
  Ncb.Ncb_Length := SizeOf(TLanaenum);
  S := Netbios(@Ncb);
  for I := 0 to Integer(Lanaenum.Length) - 1 do
  begin
    FillChar(Ncb, SizeOf(TNcb), 0);
    Ncb.Ncb_Command := Char(NcbReset);
    Ncb.Ncb_Lana_Num := Lanaenum.Lana[I];
    Netbios(@Ncb);
    Netbios(@Ncb);
    FillChar(Ncb, SizeOf(TNcb), 0);
    Ncb.Ncb_Command := Chr(NcbAstat);
    Ncb.Ncb_Lana_Num := Lanaenum.Lana[I];
    Ncb.Ncb_CallName := '*               ';
    Ncb.Ncb_Buffer := PChar(@Adapt);
    Ncb.Ncb_Length := SizeOf(TASTAT);
    M := 0;
    if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      M := 1;
    if M = 1 then
    begin
      if Netbios(@Ncb) = Chr(0) then
        StrMac := '';
      for J := 0 to 5 do
      begin
        Strpart := IntToHex(Integer(Adapt.Adapter.Adapter_address[J]), 2);
        StrMac := StrMac + Strpart + '-';
      end;
      SetLength(StrMac, Length(StrMac) - 1);
    end;
    if M = 0 then
      if Netbios(@Ncb) <> Chr(0) then
      begin
        StrMac := '';
        for J := 0 to 5 do
        begin
          Strpart := IntToHex(Integer(Adapt.Adapter.Adapter_address[J]), 2);
          StrMac := StrMac + Strpart + '-';
        end;
        SetLength(StrMac, Length(StrMac) - 1);
      end;
  end;
  Result := StrMac;
end;


////////////////////////////////////////////////////
//语法：PSetCompentNull(MyForm:TForm);
//说明：初始化组件。
//参数：MyForm   表单名称

procedure PSetCompentNull(MyForm: TForm);
var
  I: Integer;
begin
  for I := 0 to MyForm.Componentcount - 1 do
  begin
    if MyForm.Components[I] is TEdit then
      (MyForm.Components[I] as TEdit).Text := '';

    if MyForm.Components[I] is TTntEdit then
      (MyForm.Components[I] as TTntEdit).Text := '';

    if uppercase(MyForm.Components[I].classparent.ClassName)='TTNTEDIT' then
      (MyForm.Components[I] as TTntEdit).Text := '';

    if MyForm.Components[I] is TMemo then
      (MyForm.Components[I] as Tmemo).Text := '';

    if MyForm.Components[I] is TTntMemo then
      (MyForm.Components[I] as TTntmemo).Text := '';

    if MyForm.Components[I] is TDateEdit then
      (MyForm.Components[I] as TDateEdit).Text := '';
    if MyForm.Components[I] is TTimeEdit then
      (MyForm.Components[I] as TTimeEdit).Text := '';

    if MyForm.Components[I] is TImage then
      (MyForm.Components[I] as TImage).Picture.Assign(Nil);
  end;
end;

///////////////////////////////////////////////////////////////
//语法：PSetEnableColor(Frm: PTForm; ObjectColor:Tcolor);
//说明：设置组件颜色。
//参数：Frm             表单名称
//参数：ObjectColor     设置颜色

procedure PSetEnableColor(Frm: PTForm; ObjectColor: Tcolor);
var
  I: Integer;
begin
  for I := 0 to Frm^.Componentcount - 1 do
  begin
    if Frm^.Components[I] is TEdit then
      if (Frm^.Components[I] as TEdit).Enabled = False then
        (Frm^.Components[I] as TEdit).Color := ObjectColor;
    if Frm^.Components[I] is TCombobox then
      if (Frm^.Components[I] as TCombobox).Enabled = False then
        (Frm^.Components[I] as TCombobox).Color := ObjectColor;
    if Frm^.Components[I] is TDatetimepicker then
      if (Frm^.Components[I] as TDatetimepicker).Enabled = False then
        (Frm^.Components[I] as TDatetimepicker).Color := ObjectColor;
  end;
end;


//////////////////////////////////////////////////////////////////////////////
//语法：BmpToJpg(Bmpfile: String; JpgFile: String; Quality: Integer);
//说明：Bmp图片到Jpg图片的转换。
//参数：Bmpfile        源Bmp图片名
//参数：JpgFile        目标Jpg图片名
//参数：Quality        压缩率

procedure BmpToJpg(BmpFile: String; JpgFile: String; Quality: Integer);
var
  Jpeg: TJPEGImage;
  Bmp: TBitmap;
begin
  if not FileExists(BmpFile) then
    Exit;
  Bmp := TBitmap.Create;
  with Bmp do
  try
    LoadFromFile(BmpFile);           // BMP图片位置
    Jpeg := TJPEGImage.Create;
    with Jpeg do
    begin
      Assign(Bmp);
      CompressionQuality := Quality; //压缩比例
      Compress;
      SaveToFile(JpgFile);           //保存路径、文件
    end;
  finally
    Free;
  end;
end;
////////////////////////////////////////////////////////////////////////
//语法：JpgToBmp(JpgFile, BmpFile: String);
//说明：将Jpg文件转换为Bmp文件。
//参数：JpgFile     源Jpg文件名
//参数：BmpFile     目标Bmp文件名
procedure JpgToBmp(JpgFile, BmpFile: String);
var
  MyJPEG: TJPEGImage;
  MyBMP: TBitmap;
begin
  MyJPEG := TJPEGImage.Create;
  with MyJPEG do
  try
    LoadFromFile(JpgFile);    //图片位置
    MyBMP := TBitmap.Create;
    with MyBMP do
    begin
      Assign(MyJPEG);
      SaveToFile(BmpFile);   //保存路径
      Free;
    end;
  finally
    Free;
  end;
end;


{
/////////////////////////////////////////////////////////////////////////////////
//语法：InitComm(Port: Integer; Rate: LongInt; Stop, Bits: Integer; Pe: String;
//  InSize, OutSize: Integer): Integer;
//说明：
//参数：Port
//参数：Rate
//参数：Stop
//参数：Bits
//参数：Pe
//参数：InSize
//参数：OutSize
//该函数调用了ItoS、OpenComm函数。
function InitComm(Port: Integer; Rate: LongInt; Stop, Bits: Integer; Pe: String;
  InSize, OutSize: Integer): Integer;
var
  Buf: Array[0..79] of char;
  Dcb: TDCB;
begin
  StrPCopy(Buf, 'COM' + Itos(Port));
  Result := OpenComm(Buf, InSize, OutSize);
  if Result < 0 then