untfunctions.pas

一个有关Delphi 中 UDP协议的实列

  返回值:    Boolean
  说明:      程序只运行一个实列
-------------------------------------------------------------------------------}

function AppRunOnce: Boolean;
var
  HW: Thandle;
  sClassName, sTitle: string;
begin
  sClassName := application.ClassName;
  sTitle := application.Title;
  Randomize;
  application.Title := Format('F982D120-BA%dE-4199-%dFBD-F4EED%dE8A7',
    [random(20), Random(50), random(100)]); //更改当前app标题
  HW := findwindow(pchar(sClassName), pchar(sTitle));
  if HW <> 0 then application.Terminate;
  application.Title := sTitle; //恢复app标题
  result := Hw = 0;
end;

function GetDiskInfo(IdiskName: string): string;
var
 // lpFreeBytesAvailableToCaller, lpUsedBytes: int64;
  lpFreeBytesAvailableToCaller: int64;
  lpTotalNumberOfBytes: int64;
  lpTotalNumberOfFreeBytes: TLargeInteger;
  sDrive: string;
begin
  sDrive := IdiskName + ':\';
  if GetDriveType(pchar(sDrive)) = DRIVE_FIXED then begin
    GetDiskFreeSpaceEx(PChar(sDrive), lpFreeBytesAvailableToCaller,
      lpTotalNumberOfBytes, @lpTotalNumberOfFreeBytes);
   // lpUsedBytes := lpTotalNumberOfBytes - lpFreeBytesAvailableToCaller;
    Result := IntToStr(lpFreeBytesAvailableToCaller div 1024 div 1024) + 'M'
      + ' / ' + IntToStr(lpTotalNumberOfBytes div 1024 div 1024) + 'M';
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    GetFileSize
  作者:      马敏钊
  日期:      2006.01.06
  参数:      FileName: string
  返回值:    Integer
  说明:      取文件长度
-------------------------------------------------------------------------------}

function GetFileSize(FileName: string): Integer;
var
  SearchRec: TSearchRec;
begin
  try
    if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
      Result := SearchRec.Size
    else Result := -1;
  finally
    SysUtils.FindClose(SearchRec);
  end;
end;


function GetFileSize64(const FileName: string): Int64;
var
  LStream: TFileStream;
begin
{$WARNINGS OFF}
  LStream := TFileStream.Create(FileName, fmShareDenyRead);
{$WARNINGS ON}
  try
    Result := LStream.Size;
  finally
    LStream.Free;
  end;
end;

function Str_Encry(ISrc: string; key: string = 'mMz'): string;
var
  KeyLen: Integer;
  KeyPos: Integer;
  offset: Integer;
  dest: string;
  SrcPos: Integer;
  SrcAsc: Integer;
  Range: Integer;
begin
  KeyLen := Length(Key);
  KeyPos := 0;
  Range := 256;
  Randomize;
  offset := Random(Range);
  dest := format('%1.2x', [offset]);
  for SrcPos := 1 to Length(ISrc) do begin
    SrcAsc := (Ord(ISrc[SrcPos]) + offset) mod 255;
    if KeyPos < KeyLen then
      KeyPos := KeyPos + 1 else KeyPos := 1;
    SrcAsc := SrcAsc xor Ord(Key[KeyPos]);
    dest := dest + format('%1.2x', [SrcAsc]);
    offset := SrcAsc;
  end;
  Result := Dest;
end;

function Str_Decry(ISrc: string; key: string = 'mMz'): string;
var
  KeyLen: Integer;
  KeyPos: Integer;
  offset: Integer;
  dest: string;
  SrcPos: Integer;
  SrcAsc: Integer;
  TmpSrcAsc: Integer;
begin
  KeyLen := Length(Key);
  KeyPos := 0;
  offset := StrToInt('$' + copy(ISrc, 1, 2));
  SrcPos := 3;
  SrcAsc := 0;
  repeat
    try
      SrcAsc := StrToInt('$' + copy(ISrc, SrcPos, 2));
    except
    end;
    if KeyPos < KeyLen then
      KeyPos := KeyPos + 1
    else
      KeyPos := 1;
    TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
    if TmpSrcAsc <= offset then
      TmpSrcAsc := 255 + TmpSrcAsc - offset
    else
      TmpSrcAsc := TmpSrcAsc - offset;
    dest := dest + chr(TmpSrcAsc);
    offset := srcAsc;
    SrcPos := SrcPos + 2;
  until SrcPos >= Length(ISrc);
  Result := Dest;
end;
{-------------------------------------------------------------------------------
  过程名:    FormatPath
  作者:      马敏钊
  日期:      2006.01.06
  参数:      APath: string; Width: Integer
  返回值:    string
  说明:      路径太长显示的时候以...代替
-------------------------------------------------------------------------------}

function FormatPath(APath: string; Width: Integer): string;
var
  SLen: Integer;
  i, j: Integer;
  LString: string;
begin
  SLen := Length(APath);
  if (SLen <= Width) or (Width <= 6) then begin
    Result := APath;
    Exit
  end
  else begin
    i := SLen;
    LString := APath;
    for j := 1 to 2 do begin
      while (LString[i] <> '\') and (SLen - i < Width - 8) do
        i := i - 1;
      i := i - 1;
    end;
    for j := SLen - i - 1 downto 0 do
      LString[Width - j] := LString[SLen - j];
    for j := SLen - i to SLen - i + 2 do
      LString[Width - j] := '.';
    Delete(LString, Width + 1, 255);
    Result := LString;
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    RandomStr
  作者:      mmz
  日期:      2006.01.06
  参数:      aLength : Longint
  返回值:    String
  说明:      随机字符串
-------------------------------------------------------------------------------}

function RandomStr(aLength: Longint): string;
var
  X: Longint;
begin
  if aLength <= 0 then exit;
  SetLength(Result, aLength);
  for X := 1 to aLength do
    Result[X] := Chr(Random(26) + 65);
end;


{-------------------------------------------------------------------------------
  过程名:    IfThen
  作者:      马敏钊
  日期:      2006.01.06
  参数:      AValue: Boolean; const ATrue: Integer; const AFalse: Integer = 0
  返回值:    Integer
  说明:
-------------------------------------------------------------------------------}

function IfThen(AValue: Boolean; const ATrue: Integer; const AFalse: Integer = 0): Integer; overload;
begin
  if AValue then
    Result := ATrue
  else
    Result := AFalse;
end;

{-------------------------------------------------------------------------------
  过程名:    IfThen
  作者:      马敏钊
  日期:      2006.01.06
  参数:      AValue: Boolean; const ATrue: Int64; const AFalse: Int64 = 0
  返回值:    Int64
  说明:
-------------------------------------------------------------------------------}

function IfThen(AValue: Boolean; const ATrue: Int64; const AFalse: Int64 = 0): Int64; overload;
begin
  if AValue then
    Result := ATrue
  else
    Result := AFalse;
end;

{-------------------------------------------------------------------------------
  过程名:    IfThen
  作者:      马敏钊
  日期:      2006.01.06
  参数:      AValue: Boolean; const ATrue: Double; const AFalse: Double = 0.0
  返回值:    Double
  说明:
-------------------------------------------------------------------------------}

function IfThen(AValue: Boolean; const ATrue: Double; const AFalse: Double = 0.0): Double; overload;
begin
  if AValue then
    Result := ATrue
  else
    Result := AFalse;
end;

function IfThen(AValue: Boolean; const ATrue: string; const AFalse: string = ''): string; overload;
begin
  if AValue then
    Result := ATrue
  else
    Result := AFalse;
end;

function IfThen(AValue: Boolean; const ATrue: boolean; const AFalse: boolean): boolean; overload;
begin
  if AValue then
    Result := ATrue
  else
    Result := AFalse;
end;
{$IFDEF File}
{-------------------------------------------------------------------------------
  过程名:    IsFileInUse
  作者:      马敏钊
  日期:      2006.01.06
  参数:      FName: string
  返回值:    Boolean
  说明:      文件是否在使用中
-------------------------------------------------------------------------------}

function IsFileInUse(FName: string): Boolean;
var
  HFileRes: HFILE;
begin
  Result := False;
  if not FileExists(FName) then
    Exit;
  HFileRes := CreateFile(PChar(FName), GENERIC_READ or GENERIC_WRITE, 0,
    nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(HFileRes);
end;



{-------------------------------------------------------------------------------
  过程名:    GetWindowsDir
  作者:      马敏钊
  日期:      2006.01.06
  参数:      无
  返回值:    string
  说明:     取Windows系统目录
-------------------------------------------------------------------------------}

function GetWindowsDir: string;
var
  Buf: array[0..MAX_PATH] of Char;
begin
  GetWindowsDirectory(Buf, MAX_PATH);
  Result := Buf;
end;

{-------------------------------------------------------------------------------
  过程名:    GetWinTempDir
  作者:      马敏钊
  日期:      2006.01.06
  参数:      无
  返回值:    string
  说明:      取临时文件目录
-------------------------------------------------------------------------------}

function GetWinTempDir: string;
var
  Buf: array[0..MAX_PATH] of Char;
begin
  GetTempPath(MAX_PATH, Buf);
  Result := Buf;
end;
{$ENDIF}

{$IFDEF Graph}

{-------------------------------------------------------------------------------
  过程名:    RGB2BGR
  作者:      马敏钊
  日期:      2006.01.06
  参数:      C: Cardinal
  返回值:    TColor
  说明:
-------------------------------------------------------------------------------}

function RGB2BGR(C: Cardinal): TColor;
var
  R, G, B: byte;
  RGBColor: Longint;
begin
  RGBColor := ColorToRGB(C);
  R := GetRValue(RGBColor);
  G := GetGValue(RGBColor);
  B := GetBValue(RGBColor);
  Result := RGB(B, G, R);
end;

{-------------------------------------------------------------------------------
  过程名:    BGR2RGB
  作者:      马敏钊
  日期:      2006.01.06
  参数:      C: TColor
  返回值:    Cardinal
  说明:
-------------------------------------------------------------------------------}

function BGR2RGB(C: TColor): Cardinal;
var
  R, G, B: byte;
begin
  B := GetRValue(C);
  G := GetGValue(C);
  R := GetBValue(C);
  Result := RGB(R, G, B);
end;
{$ENDIF}




{$IFDEF dialog}

{-------------------------------------------------------------------------------
  过程名:    TipInfo
  作者:      马敏钊
  日期:      2006.01.06
  参数:      Info: string
  返回值:    无
  说明:
-------------------------------------------------------------------------------}

procedure TipInfo(Info: string);
begin
  MessageDlg(Info, mtInformation, [mbok], 0)
end;

{-------------------------------------------------------------------------------
  过程名:    WarningInfo
  作者:      马敏钊
  日期:      2006.01.06
  参数:      Info: string
  返回值:    无
  说明:
-------------------------------------------------------------------------------}

procedure WarningInfo(Info: string);
begin
  MessageDlg(Info, mtWarning, [mbok], 0)
end;

{-------------------------------------------------------------------------------
  过程名:    ErrorInfo
  作者:      马敏钊
  日期:      2006.01.06
  参数:      Info: string
  返回值:    无
  说明:
-------------------------------------------------------------------------------}

procedure ErrorInfo(Info: string);
begin
  MessageDlg(Info, mtError, [mbok], 0)
end;

procedure ErrorInfo(Info: string; const Args: array of const);
begin
  ErrorInfo(Format(Info, Args));
end;

{-------------------------------------------------------------------------------
  过程名:    QueryInfo
  作者:      马敏钊
  日期:      2006.01.06
  参数:      Info: string
  返回值:    Boolean
  说明:
-------------------------------------------------------------------------------}

function QueryInfo(Info: string): Boolean;
begin
  Result := MessageDlg(Info, mtConfirmation, [mbYES, mbNO], 0) = mrYES;
end;

{-------------------------------------------------------------------------------
  过程名:    ExceptTip
  作者:      马敏钊
  日期:      2006.01.06
  参数:      Info: string
  返回值:    无
  说明:
-------------------------------------------------------------------------------}

procedure ExceptTip(Info: string);
begin
  MessageDlg(Info, mtInformation, [mbok], 0);
  Abort;
end;

procedure ExceptionInfo(Info: string);
begin
  raise Exception.Create(Info);
end;