delphi常用函数库.txt

delphi常用的函数库 再不用绞尽脑汁想一些已经存在的函数了

  I: Integer; 
  S1: string; 
begin 
  S1 := HexToStr(S); 
  Result := S1; 
  for I := 1 to Length(S1) do 
  begin 
   if char(byte(S1[I]) xor (Key shr 8)) = Chr(0) then 
     begin 
      Result[I] := S1[I]; 
      Key := (byte(Chr(0)) + Key) * C1 + C2; //保证Key的正确性　　 
     end 
   else 
     begin 
      Result[I] := char(byte(S1[I]) xor (Key shr 8)); 
      Key := (byte(S1[I]) + Key) * C1 + C2; 
     end; 
  end; 
end; 

///VarIIF,VarTostr为变体函数 
function varIIF(aTest: Boolean; TrueValue, FalseValue: Variant): Variant; 
begin 
 if aTest then Result := TrueValue else Result := FalseValue; 
end; 

function varToStr(const V: Variant): string; 
begin 
 case TVarData(v).vType of 
  varSmallInt: Result := IntToStr(TVarData(v).VSmallInt); 
  varInteger: Result := IntToStr(TVarData(v).VInteger); 
  varSingle: Result := FloatToStr(TVarData(v).VSingle); 
  varDouble: Result := FloatToStr(TVarData(v).VDouble); 
  varCurrency: Result := FloatToStr(TVarData(v).VCurrency); 
  varDate: Result := DateToStr(TVarData(v).VDate); 
  varBoolean: Result := varIIf(TVarData(v).VBoolean, 'True', 'False'); 
  varByte: Result := IntToStr(TVarData(v).VByte); 
  varString: Result := StrPas(TVarData(v).VString); 
  varEmpty, 
   varNull, 
   varVariant, 
   varUnknown, 
   varTypeMask, 
   varArray, 
   varByRef, 
   varDispatch, 
   varError: Result := ''; 
 end; 
end; 


function IsDigital(Value: string): boolean; 
var 
 i, j: integer; 
 str: char; 
begin 
 result := true; 
 Value := trim(Value); 
 j := Length(Value); 
 if j = 0 then 
 begin 
  result := false; 
  exit; 
 end; 
 for i := 1 to j do 
 begin 
  str := Value[i]; 
  if not (str in ['0'..'9']) then 
  begin 
   result := false; 
   exit; 
  end; 
 end; 
end; 


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; 

//▎============================================================▎// 
//▎==================②扩展日期时间操作函数====================▎// 
//▎============================================================▎// 

function GetYear(Date: TDate): Integer; 
var 
 y, m, d: WORD; 
begin 
 DecodeDate(Date, y, m, d); 
 Result := y; 
end; 

function GetMonth(Date: TDate): Integer; 
var 
 y, m, d: WORD; 
begin 
 DecodeDate(Date, y, m, d); 
 Result := m; 
end; 

function GetDay(Date: TDate): Integer; 
var 
 y, m, d: WORD; 
begin 
 DecodeDate(Date, y, m, d); 
 Result := d; 
end; 

function GetHour(Time: TTime): Integer; 
var 
 h, m, s, ms: WORD; 
begin 
 DecodeTime(Time, h, m, s, ms); 
 Result := h; 
end; 

function GetMinute(Time: TTime): Integer; 
var 
 h, m, s, ms: WORD; 
begin 
 DecodeTime(Time, h, m, s, ms); 
 Result := m; 
end; 

function GetSecond(Time: TTime): Integer; 
var 
 h, m, s, ms: WORD; 
begin 
 DecodeTime(Time, h, m, s, ms); 
 Result := s; 
end; 

function GetMSecond(Time: TTime): Integer; 
var 
 h, m, s, ms: WORD; 
begin 
 DecodeTime(Time, h, m, s, ms); 
 Result := ms; 
end; 

//传入年、月，得到该月份最后一天 
function GetMonthLastDay(Cs_Year,Cs_Month:string):string; 
Var 
  V_date:Tdate; 
  V_year,V_month,V_day:word; 
begin 
  V_year:=strtoint(Cs_year); 
  V_month:=strtoint(Cs_month); 
  if V_month=12 then 
  begin 
    V_month:=1; 
    inc(V_year); 
  end 
  else 
  inc(V_month); 
V_date:=EncodeDate(V_year,V_month,1); 
V_date:=V_date-1; 
DecodeDate(V_date,V_year,V_month,V_day); 
Result:=DateToStr(EncodeDate(V_year,V_month,V_day)); 
end; 

//判断某年是否为闰年 
function IsLeapYear( nYear: Integer ): Boolean; 
begin 
 Result := (nYear mod 4 = 0) and ((nYear mod 100 <> 0) or (nYear mod 400 = 0)); 
end; 

//两个日期取较大的日期 
function MaxDateTime(const Values: array of TDateTime): TDateTime; 
var 
 I: Cardinal; 
begin 
 Result := Values[0]; 
 for I := 0 to Low(Values) do 
  if Values[I] < Result then Result := Values[I]; 
end; 

//两个日期取较小的日期 
function MinDateTime(const Values: array of TDateTime): TDateTime; 
var 
 I: Cardinal; 
begin 
 Result := Values[0]; 
 for I := 0 to High(Values) do 
  if Values[I] < Result then Result := Values[I]; 
end; 

//得到本月的第一一天 
function dateBeginOfMonth(D: TDateTime): TDateTime; 
var 
 Year, Month, Day: Word; 
begin 
 DecodeDate(D, Year, Month, Day); 
 Result := EncodeDate(Year, Month, 1); 
end; 

//得到本月的最后一天 
function dateEndOfMonth(D: TDateTime): TDateTime; 
var 
 Year, Month, Day: Word; 
begin 
 DecodeDate(D, Year, Month, Day); 
 if Month = 12 then 
 begin 
  Inc(Year); 
  Month := 1; 
 end else 
  Inc(Month); 
 Result := EncodeDate(Year, Month, 1) - 1; 
end; 

//得到本年的最后一天 
function dateEndOfYear(D: TDateTime): TDateTime; 
var 
 Year, Month, Day: Word; 
begin 
 DecodeDate(D, Year, Month, Day); 
 Result := EncodeDate(Year, 12, 31); 
end; 

//得到两个日期相隔的天数 
function DaysBetween(Date1, Date2: TDateTime): integer; 
begin 
 Result := Trunc(Date2) - Trunc(Date1) + 1; 
 if Result < 0 then Result := 0; 
end; 
//▎============================================================▎// 
//▎=====================③位操作函数===========================▎// 
//▎============================================================▎// 

// 设置位 
procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean); 
begin 
 if IsSet then 
  Value := Value or (1 shl Bit) 
 else 
  Value := Value and not (1 shl Bit); 
end; 

procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean); 
begin 
 if IsSet then 
  Value := Value or (1 shl Bit) 
 else 
  Value := Value and not (1 shl Bit); 
end; 

procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean); 
begin 
 if IsSet then 
  Value := Value or (1 shl Bit) 
 else 
  Value := Value and not (1 shl Bit); 
end; 

// 取位 
function GetBit(Value: Byte; Bit: TByteBit): Boolean; 
begin 
 Result := Value and (1 shl Bit) <> 0; 
end; 

function GetBit(Value: WORD; Bit: TWordBit): Boolean; 
begin 
 Result := Value and (1 shl Bit) <> 0; 
end; 

function GetBit(Value: DWORD; Bit: TDWordBit): Boolean; 
begin 
 Result := Value and (1 shl Bit) <> 0; 
end; 

//▎============================================================▎// 
//▎=================④扩展的文件及目录操作函数=================▎// 
//▎============================================================▎// 

// 移动文件、目录 
function MoveFile(const sName, dName: string): Boolean; 
var 
 s1, s2: AnsiString; 
 lpFileOp: TSHFileOpStruct; 
begin 
 s1 := PChar(sName) + #0#0; 
 s2 := PChar(dName) + #0#0; 
 with lpFileOp do 
 begin 
  Wnd := Application.Handle; 
  wFunc := FO_MOVE; 
  pFrom := PChar(s1); 
  pTo := PChar(s2); 
  fFlags := FOF_ALLOWUNDO; 
  hNameMappings := nil; 
  lpszProgressTitle := nil; 
  fAnyOperationsAborted := True; 
 end; 
 Result := SHFileOperation(lpFileOp) = 0; 
end; 

// 打开文件属性窗口 
procedure FileProperties(const FName: string); 
var 
 SEI: SHELLEXECUTEINFO; 
begin 
 with SEI do 
 begin 
  cbSize := SizeOf(SEI); 
  fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or 
   SEE_MASK_FLAG_NO_UI; 
  Wnd := Application.Handle; 
  lpVerb := 'properties'; 
  lpFile := PChar(FName); 
  lpParameters := nil; 
  lpDirectory := nil; 
  nShow := 0; 
  hInstApp := 0; 
  lpIDList := nil; 
 end; 
 ShellExecuteEx(@SEI); 
end; 

// 缩短显示不下的长路径名 
function FormatPath(APath: string; Width: Integer): string; 
var 
 SLen: Integer; 
 i, j: Integer; 
 TString: string; 
begin 
 SLen := Length(APath); 
 if (SLen <= Width) or (Width <= 6) then 
 begin 
  Result := APath; 
  Exit 
 end 
 else 
 begin 
  i := SLen; 
  TString := APath; 
  for j := 1 to 2 do 
  begin 
   while (TString[i] <> '\') and (SLen - i < Width - 8) do 
    i := i - 1; 
   i := i - 1; 
  end; 
  for j := SLen - i - 1 downto 0 do 
   TString[Width - j] := TString[SLen - j]; 
  for j := SLen - i to SLen - i + 2 do 
   TString[Width - j] := '.'; 
  Delete(TString, Width + 1, 255); 
  Result := TString; 
 end; 
end; 

// 打开文件框 
function OpenDialog(var FileName: string; Title: string; Filter: string; 
 Ext: string): Boolean; 
var 
 OpenName: TOPENFILENAME; 
 TempFilename, ReturnFile: string; 
begin 
 with OpenName do 
 begin 
  lStructSize := SizeOf(OpenName); 
  hWndOwner := GetModuleHandle(''); 
  Hinstance := SysInit.Hinstance; 
  lpstrFilter := PChar(Filter + #0 + Ext + #0#0); 
  lpstrCustomFilter := ''; 
  nMaxCustFilter := 0; 
  nFilterIndex := 1; 
  nMaxFile := MAX_PATH; 
  SetLength(TempFilename, nMaxFile + 2); 
  lpstrFile := PChar(TempFilename); 
  FillChar(lpstrFile^, MAX_PATH, 0); 
  SetLength(TempFilename, nMaxFile + 2); 
  nMaxFileTitle := MAX_PATH; 
  SetLength(ReturnFile, MAX_PATH + 2); 
  lpstrFileTitle := PChar(ReturnFile); 
  FillChar(lpstrFile^, MAX_PATH, 0); 
  lpstrInitialDir := '.'; 
  lpstrTitle := PChar(Title); 
  Flags := OFN_HIDEREADONLY + OFN_ENABLESIZING; 
  nFileOffset := 0; 
  nFileExtension := 0; 
  lpstrDefExt := PChar(Ext); 
  lCustData := 0; 
  lpfnHook := nil; 
  lpTemplateName := ''; 
 end; 
 Result := GetOpenFileName(OpenName); 
 if Result then 
  FileName := ReturnFile 
 else 
  FileName := ''; 
end; 

// 取两个目录的相对路径,注意串尾不能是'\'字符! 
function GetRelativePath(Source, Dest: string): string; 
 // 比较两路径字符串头部相同串的函数 
 function GetPathComp(s1, s2: string): Integer; 
 begin 
  if Length(s1) > Length(s2) then swapStr(s1, s2); 
  Result := Pos(s1, s2); 
  while (Result = 0) and (Length(s1) > 3) do 
  begin 
   if s1 = '' then Exit; 
   s1 := ExtractFileDir(s1); 
   Result := Pos(s1, s2); 
  end; 
  if Result <> 0 then Result := Length(s1); 
  if Result = 3 then Result := 2; 
  // 修正因ExtractFileDir()处理'c:\'时产生的错误. 
 end; 
 // 取Dest的相对根路径的函数 
 function GetRoot(s: ShortString): string; 
 var 
  i: Integer; 
 begin 
  Result := ''; 
  for i := 1 to Length(s) do 
   if s[i] = '\' then Result := Result + '..\'; 
  if Result = '' then Result := '.\'; 
  // 如果不想处理成".\"的路径格式，可去掉本行 
 end; 

var 
 RelativRoot, RelativSub: string; 
 HeadNum: Integer; 
begin 
 Source := UpperCase(Source); 
 Dest := UpperCase(Dest);       // 比较两路径字符串头部相同串 
 HeadNum := GetPathComp(Source, Dest); // 取Dest的相对根路径 
 RelativRoot := GetRoot(StrRight(Dest, Length(Dest) - HeadNum)); 
 // 取Source的相对子路径 
 RelativSub := StrRight(Source, Length(Source) - HeadNum - 1); 
 // 返回 
 Result := RelativRoot + RelativSub; 
end; 

// 运行一个文件 
procedure RunFile(const FName: string; Handle: THandle; 
 const Param: string); 
begin 
 ShellExecute(Handle, nil, PChar(FName), PChar(Param), nil, SW_SHOWNORMAL); 
end; 

// 运行一个文件并等待其结束 
function WinExecAndWait32(FileName: string; Visibility: Integer): Integer; 
var 
 zAppName: array[0..512] of Char; 
 zCurDir: array[0..255] of Char; 
 WorkDir: string; 
 StartupInfo: TStartupInfo; 
 ProcessInfo: TProcessInformation; 
begin 
 StrPCopy(zAppName, FileName); 
 GetDir(0, WorkDir);