delphi的一个公用函数库

最新推荐文章于 2019-01-07 23:15:19 发布
最新推荐文章于 2019-01-07 23:15:19 发布
阅读量2.8k 收藏
点赞数
文章标签： delphi integer string function stream file
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/qhmao/article/details/1600108
版权

delphi的一个公用函数库
  {**********************************************
***  Name: PublicFunc;
***  Author: lyz 2004-3-17;
***
***  Function: 公共函数；
**********************************************}
unit PublicFunc;

interface

uses
  Windows, Math , SysUtils, Classes ,ShlObj, ActiveX, ComObj, Registry, Db,
  Controls, Dialogs, XMLDoc, XMLIntf;

type
{ TStream seek origins }
  TFolderNo = (Desktop, StartMenu, Programs);

type

 TCPUID = array[1..4] of Longint;
 TVendor = array [0..11] of char;

  TObjList=class (TList)
  public
    destructor Destroy; override;
    procedure Clear; override;
    procedure SaveToStream(stream: TStream); virtual;
    procedure LoadFromStream(stream: TStream); virtual;
  end;

var
  _DecNum: Integer;

  _RoundValue: Double;

  _EquMinValue: Double;

  _ZeroMinValue: Double;


 

 

//*************LYZ
function StrIsEmpty (s: String): Boolean;

//procedure StringWrite (f: file; s: String);

//procedure StringRead (f: file; s: String);

function SLtrim (s: String): String;

function STrim (s: String): String;

function SAllTrim (s: String): String;

function SRemoveSpace (s: String): String;//除掉空格

procedure SSplitString (s: String; s1: String; s2: String);

procedure SSplitString1 (s: String; s1: String; s2: String);

function SIntToStrFix (n: Integer; cnt: Integer): String;

function ARound (v: Double): Double;   //求整

function ARoundN (v: Double; n: Integer): Double;  //保留几位小数

function AEqu (v1: Double; v2: Double): Boolean;    //两个是否相等

function ASmall (v1: Double; v2: Double): Boolean;  file://v1 < v2

function ABig (v1: Double; v2: Double): Boolean;    file://v1 > v2

function AIsZero (v1: Double): Boolean;  file://判断是否为零

function AMax (a: Double; b: Double): Double;  file://返回大值

function AMin (a: Double; b: Double): Double;  file://返回小值

procedure ASwap (p1: Double; p2: Double);  file://交换

function IMax (a: Integer; b: Integer): Integer; file://返回大值

function IMin (a: Integer; b: Integer): Integer; file://返回小值

procedure ISwap (p1: Integer; p2: Integer);  file://交换

function RealToStr (v: Double): String;   file://Double转换成String

function RealToStr1 (v: Double): String;

function StrToReal (s: String): Double;  file://String转换成Double

function RealStr (v: Double): String;    file://Double转换成String

function RealStrN (v: Double; dec: Integer): String;  file://保留几位小数 Double转换成String

function RealDateN(v: Double): String;  file://日期转化成字符

function IsDate(const str: string): Boolean;

function GetDate(const str: string): TDateTime;  file://字符转化成日期

function RealStr1 (v: Double; len: Integer; dec: Integer): String;

function RealStr2 (v: Double; len: Integer; dec: Integer): String;

function RealStr3 (v: Double; len: Integer; dec: Integer): String;

function RealStr4 (v: Double; len: Integer; dec: Integer): String;

function StrInt (s: String): Integer;   file://string 转换成 integer
file://xml

procedure WriteXMLValue(XML : IXMLNode; Const mc : string; Var Val: string);

procedure ReadXMLValue(XML : IXMLNode; Const mc : string; Var Val: string);

file://以下是保存为数据流
procedure WriteToStream (stream: TStream; const Number: Integer); overload;

procedure WriteToStream (stream: TStream; const Number: Int64); overload;

procedure WriteToStream (stream: TStream; const v: Cardinal); overload;

procedure WriteToStream (stream: TStream; const v: Word); overload;

procedure WriteToStream (stream: TStream; const Filestr: String); overload;

procedure WriteToStream (stream: TStream; const v: Double); overload;

procedure WriteToStream (stream: TStream; const Bool: Boolean); overload;

procedure ReadFromStream (stream: TStream; var v: Cardinal); overload;

procedure WriteToStream (stream: TStream; const Number: Extended); overload;

procedure ReadFromStream (stream: TStream; var v: Extended); overload;

procedure ReadFromStream (stream: TStream; var Number: Integer); overload;

procedure ReadFromStream (stream: TStream; var Number: Int64); overload;

procedure ReadFromStream (stream: TStream; var v: Word); overload;

procedure ReadFromStream (stream: TStream; var Filestr: String); overload;

procedure ReadFromStream (stream: TStream; var v: Double); overload;

procedure ReadFromStream (stream: TStream; var Bool: Boolean); overload;

procedure WriteToStream (stream: TStream; const sList: TStringList); overload;

procedure ReadFromStream (stream: TStream; var sList: TStringList); overload;

procedure WriteToStream (stream: TStream; const iary: array of Integer); overload;

procedure ReadFromStream (stream: TStream; var iary: array of Integer); overload;

function StrLike (sou: String; key: String): Boolean;  file://sou中是否包括key

function SRight (s: String; n: Integer): String;      file://取右边多少个字符

procedure LoadFileList (Path: String; slist: TStrings; noPath: Boolean);

function TimeTicket: Longint;

function MonthOfDate (date: TDateTime): Integer;

function DayOfDate (date: TDateTime): Integer;

function YearOfDate (date: TDateTime): Integer;

function GetSplitWord (s: String; splitc: Char): String;

function HexToInt (s: String): Integer;         file://16进制转换成10进制

function TransStrByTable (sou: String; ori: TStringList; des: TStringList): String;

procedure LoadTransTable (fn: String; sou: TStringList; tag: TStringList);

function MakeFilePath (s: String): String;

function RemoveNote (s: String): String;

function MakePath (path: String): String;

function Blone (tj: String; v: String): Boolean;

function CodeStr (s: String): String;

function DeCodeStr (s: String): String;

function GetValueFromStr (vname: String; s: String; txt: String): Boolean;

function GetParaList (txt: String; ss: TStringList): Boolean;

function SReplace (txt: String; sou: String; tag: String): String;

Function GetOSInfo: String;     file://NT 还是 Windows 98?取得当前操作平台

function GetCurrentUserName : string; file://获取当前Windows用户的登录名

Procedure SetLink(FolderNo: TFolderNo; ACmdFile, Parameter, LinkName: string);//创建快捷方式

function Myrandom(Num: Integer): integer;//一个利用系统时间产生随机数的程序该随机数的范围是0到Num

function GetMouseHwndAndClassName(Sender: TObject): string;

function GetMousePosHwndAndClassName(Sender: TPoint): string; file://获取当前鼠标位置的类名和句柄

function GetIdeDiskSerialNumber : String;  file://取Ide硬盘序列号函数

file://得到CpuID号
function GetCPUID : TCPUID; assembler; register;

function GetCPUVendor : TVendor; assembler; register;

function GetCPUIDStr: String;

{日期型字段显示过程,在OnGetText事件中调用}
procedure DateFieldGetText(Sender: TField; var Text: String);

{日期型字段输入判断函数,在OnSetText事件中调用}
function DateFieldSetText(Sender: TField; const Text: String):Boolean;


  file://不能输入字符
function CheckNullValue(var Key: Char): Boolean;
{判断输入的字符是否是数字}
function CheckInputNum(const IsInteger: Boolean; AStr: string; var Key: Char): Boolean;

file://得到下一编号
function  GetNextStrId(const PreId: string): string;   // preId := 'LX000000';

implementation

file://得到下一编号
function  GetNextStrId(const PreId: string): string;   // preId := 'LX000000';
var
  I,n,n1:   Integer;
  s,s1:  string;
  c:     char;
begin
  n := Length(PreId);
  n1 := 0;
  for I := n downto 1 do begin
    c := PreId[I];
    if  (Ord(c) >= 65) and (Ord(c) <= 90) then begin
       n1 := I;
       Break;
    end;
  end;
  s := Copy(PreId, 1, n1);
  s1 := Copy(PreId, n1 + 1, 100);
  s1 := IntToStr(StrInt(s1) + 1);
  result := s1;
  for I := 1 to  n - n1 - Length(s1) do
    Result := '0' + Result;
  result := s + Result;
end;

file://不能输入字符
function CheckNullValue(var Key: Char): Boolean;
const
  ControlKeySet = [Char(#13)];
begin
  Key := #0;
  Result := True;
end;

{判断输入的字符是否是数字}
function CheckInputNum(const IsInteger: Boolean; AStr: string; var Key: Char): Boolean;
const
  NumberSet = ['0' .. '9', '.', '-'];
  ControlKeySet = [Char(#8), Char(#13)];
begin
  if Key in ControlKeySet then begin
    Result := True;
    Exit;
  end;

  if not (Key in NumberSet) then Key := #0;
  if (Key = '.') and ((Length(AStr) = 0) or (Pos('.', AStr) > 0)) then
    Key := #0;

  file://不能前两个同时为0
  if (Length(AStr) = 1) and (AStr[1] = '0') and (Key = '0') then Key := #0;

  file://不能有多个负号
  if (Pos('-', AStr) >= 0) and (Key = '-') then Key := #0;

  if IsInteger then begin
    if key = '.' then Key := #0;
//    if (Length(AStr) = 1) and (AStr[1] = '0') or (Key = '.') then Key := #0;
  end;
  Result := Key <> #0;
end;

{日期型字段显示过程,在OnGetText事件中调用}
procedure DateFieldGetText(Sender: TField; var Text: String);
var
  dDate: TDate;
  wYear,wMonth,wDay: Word;
  aryTestYMD: Array [1..2] of Char ;{测试输入掩码用临时数组}
  iYMD: Integer;
begin
  iYMD := 0;
  dDate:= Sender.AsDateTime;
  DecodeDate(dDate,wYear,wMonth,wDay);
  {测试输入掩码所包含的格式.}
  aryTestYMD:= '年';
  if StrScan(PChar(Sender.EditMask), aryTestYMD[1]) <> nil then iYMD:= 1;
  aryTestYMD:= '月';
  if StrScan(PChar(Sender.EditMask), aryTestYMD[1]) <> nil then iYMD:= 2;
  aryTestYMD:= '日';
  if StrScan(PChar(Sender.EditMask), aryTestYMD[1]) <> nil then iYMD:= 3;
  case iYMD of
    1:{输入掩码为:”yyyy年”的格式.}
    Text:= IntToStr(wYear) + '年';
    2: {输入掩码为:”yyyy年mm月”的格式.}
    Text:= IntToStr(wYear) + '年' + IntToStr(wMonth) + '月';
    3: {输入掩码为:”yyyy年mm月dd日”的格式.}
    Text:= IntToStr(wYear) + '年' + IntToStr(wMonth) + '月' + IntToStr(wDay) + '日';
    else {默认为:”yyyy年mm月dd日”的格式.}
    Text:= IntToStr(wYear) + '年' + IntToStr(wMonth) + '月' + IntToStr(wDay) + '日';
  end;
end;

{日期型字段输入判断函数,在OnSetText事件中调用}
function DateFieldSetText(Sender: TField; const Text: String):Boolean;
var
  dDate: TDate;
  sYear,sMonth,sDay: String;
  aryTestYMD: Array [1..2] of Char;
  iYMD: Integer;
begin
  iYMD := 0;
{获得用户输入的日期}
  sYear := Copy(Text, 1, 4);
  sMonth:= Copy(Text, 7, 2);
  SDay  := Copy(Text, 11, 2);
{测试输入掩码所包含的格式.}
  aryTestYMD := '年';
  if StrScan( PChar(Sender.EditMask), aryTestYMD[1] ) <> nil then iYMD := 1;
  aryTestYMD := '月';
  if StrScan( PChar(Sender.EditMask), aryTestYMD[1] ) <> nil then iYMD := 2;
  aryTestYMD := '日';
  if StrScan( PChar(Sender.EditMask), aryTestYMD[1] ) <> nil then iYMD := 3;
  {利用Try…Except进行输入的日期转换}
  try begin
    case iYMD of
      1: {输入掩码为:”yyyy年”的格式.}
        begin
        dDate := StrToDate( sYear + '-01-01' );{中文Windows默认的日期格式为:yyyy-mm-dd.下同}
        Sender.AsDateTime := dDate;
        end;
      2: {输入掩码为:”yyyy年mm月”的格式.}
        begin
        dDate := StrToDate( sYear + '-' + sMonth + '-01' );
        Sender.AsDateTime:=dDate;
        end;
      3: {输入掩码为:”yyyy年mm月dd日”的格式.}
        begin
        dDate := StrToDate( sYear + '-' + sMonth + '-' + sDay );
        Sender.AsDateTime := dDate;
        end;
      else {默认为:”yyyy年mm月dd日”的格式.}
        begin
        dDate := StrToDate( sYear + '-' + sMonth + '-' + sDay );
        Sender.AsDateTime := dDate;
        end;
    end;
    DateFieldSetText := True;
  end;
  except
    {日期转换出错}
    begin
      showmessage( PChar ( Text + '不是有效的日期!'));
      DateFieldSetText := False;
    end;
end;

end;


function GetMouseHwndAndClassName(Sender: TObject): string;
var
rPos: TPoint;
begin
  Result := '';
  if boolean(GetCursorPos(rPos)) then Result := GetMousePosHwndAndClassName(rPos);
end;

function GetMousePosHwndAndClassName(Sender: TPoint): string;
var
  hWnd: THandle;
  aName: array [0..255] of char;
  tmpstr: string;
begin
  tmpstr := '';
  hWnd := WindowFromPoint(Sender);
  tmpstr := 'Handle : ' + IntToStr(hWnd);

  if boolean(GetClassName(hWnd, aName, 256)) then
    tmpstr := 'ClassName : ' + string(aName)
  else
    tmpstr := 'ClassName : not found';
  Result := tmpstr; 
end;

function Myrandom(Num: Integer): integer;
var
  T: _SystemTime;
  X: integer;
  I: integer;
begin
  Result := 0;
  Randomize;
  If Num = 0 then Exit;
  GetSystemTime(T);
  X := Trunc(T.wMilliseconds/10) * T.wSecond * 1231;
  X := X + random(1);
  if X < 0 then X := -X;
  X := Random(X);
  X := X mod num;
  for I := 0 to X do
    X := Random(Num);
  Result := X;
end;


function GetCurrentUserName : string;
const
  cnMaxUserNameLen = 254;
var
  sUserName : string;
  dwUserNameLen : Dword;
begin
  dwUserNameLen := cnMaxUserNameLen-1;
  SetLength( sUserName, cnMaxUserNameLen );
  GetUserName(Pchar( sUserName ), dwUserNameLen );
  SetLength( sUserName, dwUserNameLen );
  Result := sUserName;
end;

Procedure SetLink(FolderNo: TFolderNo; ACmdFile, Parameter, LinkName: string);
var
  MyObject : Iunknown;
  MySLink : IShellLink;
  MyPFile : IPersistFile;
  FileName : string;
  Directory : string;
  WFileName : WideString;
  MyReg : TRegIniFile;
  tmpFolderNo : string;
begin
  if FolderNo = Desktop then tmpFolderNo:= 'Desktop';
  if FolderNo = StartMenu then tmpFolderNo:= 'StartMenu';
  if FolderNo = Programs then tmpFolderNo:= 'Programs';
   
  MyObject := CreateComObject(CLSID_ShellLink);
  MySLink := MyObject as IShellLink;
  MyPFile := MyObject as IPersistFile;
  FileName := ACmdFile;
  with MySLink do
  begin
    SetArguments(Pchar(Parameter));
    SetPath(Pchar(FileName));
    SetWorkingDirectory(Pchar(ExtractFilePath(FileName)));
  end;
  MyReg := TRegIniFile.Create('Software/MicroSoft/Windows/CurrentVersion/Explorer');

  Directory := MyReg.ReadString('Shell Folders', tmpFolderNo,'');
  file://CreateDir(Directory);
  WFileName := Directory + '/' + LinkName + '.lnk';
  MyPFile.Save(PWChar(WFileName),False);
  MyReg.Free;
end;


Function GetOSInfo: String;
var
  VI: TOSVersionInfo;
begin
  Result:= '';
  VI.dwOSVersionInfoSize := SizeOf(VI);
  GetVersionEx(VI);//取得正在运行的Windeows和Win32操作系统的版本

//  VI.dwPlatformId
  Result:= Result + Format('%d%d%d',[VI.dwMajorVersion,VI.dwMinorVersion,VI.dwBuildNumber]);
  Result:= Result + GetIdeDiskSerialNumber + GetCPUIDStr;
  case Win32Platform of
    VER_PLATFORM_WIN32_WINDOWS: Result := Result + 'Windows 95/98';
    VER_PLATFORM_WIN32_NT: Result := Result + 'Windows NT';
  else
    Result := Result + 'Windows32';
  end;
end;

function GetCPUID : TCPUID; assembler; register;
asm
  PUSH    EBX         {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX     {@Resukt}
  MOV     EAX,1
  DW      $A20F       {CPUID Command}
  STOSD             {CPUID[1]}
  MOV     EAX,EBX
  STOSD               {CPUID[2]}
  MOV     EAX,ECX
  STOSD               {CPUID[3]}
  MOV     EAX,EDX
  STOSD               {CPUID[4]}
  POP     EDI     {Restore registers}
  POP     EBX
end;

function GetCPUVendor : TVendor; assembler; register;
asm
  PUSH    EBX     {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX   {@Result (TVendor)}
  MOV     EAX,0
  DW      $A20F    {CPUID Command}
  MOV     EAX,EBX
  XCHG  EBX,ECX     {save ECX result}
  MOV   ECX,4
@1:
  STOSB
  SHR     EAX,8
  LOOP    @1
  MOV     EAX,EDX
  MOV   ECX,4
@2:
  STOSB
  SHR     EAX,8
  LOOP    @2
  MOV     EAX,EBX
  MOV   ECX,4
@3:
  STOSB
  SHR     EAX,8
  LOOP    @3
  POP     EDI     {Restore registers}
  POP     EBX
end;

function GetCPUIDStr: String;
var
  CPUID : TCPUID;
  I     : Integer;
  S   : TVendor;
begin
  Result := '';
 for I := Low(CPUID) to High(CPUID)  do CPUID[I] := -1;
    CPUID := GetCPUID;
  Result := Result + IntToHex(CPUID[1],8);
  Result := Result + IntToHex(CPUID[2],8);
  Result := Result + IntToHex(CPUID[3],8);
  Result := Result + IntToHex(CPUID[4],8);
  S := GetCPUVendor;
  Result := Result + S;
end;

function GetIdeDiskSerialNumber : String;  file://取Ide硬盘序列号函数
  type
    TSrbIoControl = packed record
    HeaderLength : ULONG;
    Signature : Array[0..7] of Char;
    Timeout : ULONG;
    ControlCode : ULONG;
    ReturnCode : ULONG;
    Length : ULONG;
  end;
  SRB_IO_CONTROL = TSrbIoControl;
  PSrbIoControl = ^TSrbIoControl;

  TIDERegs = packed record
    bFeaturesReg : Byte; // Used for specifying SMART "commands".
    bSectorCountReg : Byte; // IDE sector count register
    bSectorNumberReg : Byte; // IDE sector number register
    bCylLowReg : Byte; // IDE low order cylinder value
    bCylHighReg : Byte; // IDE high order cylinder value
    bDriveHeadReg : Byte; // IDE drive/head register
    bCommandReg : Byte; // Actual IDE command.
    bReserved : Byte; // reserved. Must be zero.
  end;
  IDEREGS = TIDERegs;
  PIDERegs = ^TIDERegs;

  TSendCmdInParams = packed record
    cBufferSize : DWORD;
    irDriveRegs : TIDERegs;
    bDriveNumber : Byte;
    bReserved : Array[0..2] of Byte;
    dwReserved : Array[0..3] of DWORD;
    bBuffer : Array[0..0] of Byte;
  end;
  SENDCMDINPARAMS = TSendCmdInParams;
  PSendCmdInParams = ^TSendCmdInParams;

  TIdSector = packed record
    wGenConfig : Word;
    wNumCyls : Word;
    wReserved : Word;
    wNumHeads : Word;
    wBytesPerTrack : Word;
    wBytesPerSector : Word;
    wSectorsPerTrack : Word;
    wVendorUnique : Array[0..2] of Word;
    sSerialNumber : Array[0..19] of Char;
    wBufferType : Word;
    wBufferSize : Word;
    wECCSize : Word;
    sFirmwareRev : Array[0..7] of Char;
    sModelNumber : Array[0..39] of Char;
    wMoreVendorUnique : Word;
    wDoubleWordIO : Word;
    wCapabilities : Word;
    wReserved1 : Word;
    wPIOTiming : Word;
    wDMATiming : Word;
    wBS : Word;
    wNumCurrentCyls : Word;
    wNumCurrentHeads : Word;
    wNumCurrentSectorsPerTrack : Word;
    ulCurrentSectorCapacity : ULONG;
    wMultSectorStuff : Word;
    ulTotalAddressableSectors : ULONG;
    wSingleWordDMA : Word;
    wMultiWordDMA : Word;
    bReserved : Array[0..127] of Byte;
  end;
  PIdSector = ^TIdSector;

const
  IDE_ID_FUNCTION = $EC;
  IDENTIFY_BUFFER_SIZE = 512;
  DFP_RECEIVE_DRIVE_DATA = $0007c088;
  IOCTL_SCSI_MINIPORT = $0004d008;
  IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501;
  DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
  BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;
  W9xBufferSize = IDENTIFY_BUFFER_SIZE+16;

var
  hDevice : THandle;
  cbBytesReturned : DWORD;
  pInData : PSendCmdInParams;
  pOutData : Pointer; // PSendCmdOutParams
  Buffer : Array[0..BufferSize-1] of Byte;
  srbControl : TSrbIoControl absolute Buffer;

  procedure ChangeByteOrder( var Data; Size : Integer );
  var
    ptr : PChar;
    i : Integer;
    c : Char;
  begin
    ptr := @Data;
    for i := 0 to (Size shr 1)-1 do begin
      c := ptr^;
      ptr^ := (ptr+1)^;
      (ptr+1)^ := c;
      Inc(ptr,2);
     end;
  end;

begin
  Result := '';
  FillChar(Buffer,BufferSize,#0);
  if Win32Platform=VER_PLATFORM_WIN32_NT then begin // Windows NT, Windows 2000
// Get SCSI port handle
    hDevice := CreateFile( '//./Scsi0:',GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE,
                          nil, OPEN_EXISTING, 0, 0 );
    if hDevice=INVALID_HANDLE_VALUE then Exit;
    try
      srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
      System.Move('SCSIDISK',srbControl.Signature,8);
      srbControl.Timeout := 2;
      srbControl.Length := DataSize;
      srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
      pInData := PSendCmdInParams(PChar(@Buffer) + SizeOf(SRB_IO_CONTROL));
      pOutData := pInData;
      with pInData^ do begin
        cBufferSize := IDENTIFY_BUFFER_SIZE;
        bDriveNumber := 0;
        with irDriveRegs do begin
          bFeaturesReg := 0;
          bSectorCountReg := 1;
          bSectorNumberReg := 1;
          bCylLowReg := 0;
          bCylHighReg := 0;
          bDriveHeadReg := $A0;
          bCommandReg := IDE_ID_FUNCTION;
        end;
      end;
      if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT,
      @Buffer, BufferSize, @Buffer, BufferSize,
      cbBytesReturned, nil ) then Exit;
    finally
      CloseHandle(hDevice);
    end;
  end else begin // Windows 95 OSR2, Windows 98
    hDevice := CreateFile( '//./SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
    if hDevice=INVALID_HANDLE_VALUE then Exit;
    try
      pInData := PSendCmdInParams(@Buffer);
      pOutData := @pInData^.bBuffer;
      with pInData^ do begin
        cBufferSize := IDENTIFY_BUFFER_SIZE;
        bDriveNumber := 0;
        with irDriveRegs do begin
          bFeaturesReg := 0;
          bSectorCountReg := 1;
          bSectorNumberReg := 1;
          bCylLowReg := 0;
          bCylHighReg := 0;
          bDriveHeadReg := $A0;
          bCommandReg := IDE_ID_FUNCTION;
        end;
      end;
      if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA,
            pInData, SizeOf(TSendCmdInParams)-1, pOutData,
            W9xBufferSize, cbBytesReturned, nil ) then Exit;
    finally
      CloseHandle(hDevice);
    end;
  end;
  with PIdSector(PChar(pOutData)+16)^ do begin
    ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
    SetString(Result,sSerialNumber,SizeOf(sSerialNumber));
  end;
end;

procedure TObjList.Clear;
begin
  inherited;

end;

destructor TObjList.Destroy;
begin

  inherited;
end;

function StrIsEmpty (s: String): Boolean;
begin
  Result := False;
  if s = '' then
    Result := True;
end;

{procedure StringWrite (f: file; s: String);
begin
end;

procedure StringRead (f: file; s: String);
begin
end;
 }
function SLtrim (s: String): String;
begin
end;

function STrim (s: String): String;
begin
end;

function SAllTrim (s: String): String;
begin
end;

function SRemoveSpace (s: String): String;
var
  I     : Integer;
  Count : Integer;
begin
  Result:= '';
  Count := length(s);
  for I := 1 to Count do begin
    if s[I] <> ' ' then begin
      Result  := Result + s[I];
    end;
  end;
end;

procedure SSplitString (s: String; s1: String; s2: String);
begin
end;

procedure SSplitString1 (s: String; s1: String; s2: String);
begin
end;

function SIntToStrFix (n: Integer; cnt: Integer): String;
begin
end;

function ARound (v: Double): Double;
begin
  Result := Round(V);
end;

function ARoundN (v: Double; n: Integer): Double;
var
  I   : Integer;
begin
  result := v;
  for I := 0 to N - 1 do begin
    Result := Result * 10;
  end;
  Result := Round(Result);
  for I := 0 to N - 1 do begin
    Result := Result / 10;
  end;
end;

function AEqu (v1: Double; v2: Double): Boolean;
begin
  result := False;
  if v1 = v2 then
    result := True
end;

function ASmall (v1: Double; v2: Double): Boolean;
begin
  result := False;
  if v1 < v2 then
    result := True;
end;

function ABig (v1: Double; v2: Double): Boolean;
begin
  result := False;
  if v1 > v2 then
    result := True;
end;

function AIsZero (v1: Double): Boolean;
begin
  Result := False;
  if V1 = 0 then Result := True;
end;

function AMax(a: Double; b: Double): Double;
begin
  if a >= b then
    result := a
  else
    result := b;
end;

function AMin(a: Double; b: Double): Double;
begin
  if a >= b then
    result := b
  else
    result := a;
end;

procedure ASwap (p1: Double; p2: Double);
begin

end;

function IMax(a: Integer; b: Integer): Integer;
begin
 if a >= b then
   result := a
 else
   result := b;
end;

function IMin(a: Integer; b: Integer): Integer;
begin
 if a >= b then
   result := b
 else
   result := a;
end;

procedure ISwap (p1: Integer; p2: Integer);
begin

end;

function RealToStr (v: Double): String;
begin
  result := FloatToStr(v);
end;

function RealToStr1 (v: Double): String;
begin
end;

function StrToReal(s: String): Double;
var
  I : Integer;
  B : Boolean;
begin
  B := True;
  result := 0;
  for I := 1 to length(s) do begin
    if (ord(s[I]) > 57) or (ord(s[I]) < 48) then begin
      if ord(s[I]) <> 46 then begin
        B := False;
        Break;
      end;
    end;
  end;

  if B and (Length(s) <> 0) then
    result := StrToFloat(s)
end;

function RealStr (v: Double): String;
begin
  result := FloatToStr(v);
end;

function FloatToFloat(Const D: Double; Const N: integer): Double;
var
  I   : integer;
  Max : LongInt;
begin
  Max := 1;
  for I := 1 to N do begin
    Max := Max * 10;
  end;
  result := D * Max;
  result := Round(result);
  result := result / Max;
end;

function RealStrN (v: Double; dec: Integer): String;
var
  TD : Double;
begin
  TD := FloatToFloat(V, dec);
  result := FloatToStr(TD);
end;

function RealDateN(v: Double): String;
var
  Year, Month, Day : word;
begin
  DecodeDate(v, Year, Month, Day);
  result := IntToStr(year) + '年' + IntToStr(Month) + '月' + IntToStr(Day) + '日';
end;

function IsDate(const str: string): Boolean;
begin
  try
    StrToDate(str);
  except
    Result := False;
    Exit;
  end;
  Result := True;
end;

function GetDate(const str: string): TDateTime;
var
  NewStr: string;
begin
  NewStr := str;
  NewStr := StringReplace(NewStr,'年','-',[]);
  NewStr := StringReplace(NewStr,'月','-',[]);
  NewStr := StringReplace(NewStr,'日','',[]);

  if IsDate(NewStr) then Result := StrToDate(NewStr)
  else Result := SysUtils.Date;
end;

function RealStr1 (v: Double; len: Integer; dec: Integer): String;
begin
 
end;

function RealStr2 (v: Double; len: Integer; dec: Integer): String;
begin
end;

function RealStr3 (v: Double; len: Integer; dec: Integer): String;
begin
end;

function RealStr4 (v: Double; len: Integer; dec: Integer): String;
begin
end;

function StrInt (s: String): Integer;
var
  I : Integer;
  B : Boolean;
begin
  B := True;
  result := 0;
  if s = '' then begin
    result := 0;
    Exit;
  end;
  for I := 1 to length(s) do begin
    if (ord(s[I]) > 57) or (ord(s[I]) < 48) then begin
      B := False;
      Break;
    end;
  end;

  if B and (Length(s) <> 0) then
    result := StrToInt(s)
end;

procedure WriteXMLValue(XML : IXMLNode; Const mc : string; Var Val: string);
var
  Child_Node : IXMLNode;
begin
  Child_Node := XML.AddChild(mc);
  Child_Node.Text := Val;
end;

procedure ReadXMLValue(XML : IXMLNode; Const mc : string; Var Val: string);
var
  Child_Node : IXMLNode;
begin
  Child_Node := XML.ChildNodes.First;
  if (Child_Node.NodeName = mc) then
    Val := Child_Node.Text;
end;

procedure ReadFromStream(Stream: TStream; var Bool: Boolean);
begin
  Stream.Read(Bool,SizeOf(Bool));
end;

procedure ReadFromStream(Stream: TStream; var Number: integer);
begin
  Stream.Read(Number,SizeOf(Number));
end;

procedure ReadFromStream (stream: TStream; var Number: Int64); overload;
begin
  Stream.Read(Number,SizeOf(Number));
end;

procedure ReadFromStream(Stream: TStream; var Filestr: string);
var
  Count : integer;
  I : integer;
  S : Char;
begin
  Filestr := '';
  Count := 0;
  ReadFromStream(Stream, Count);
  for I := 1 to Count do begin
    Stream.Read(S, 1);
    Filestr:= Filestr + s;
  end;
end;

procedure WriteToStream(Stream: TStream; const Number: integer);
begin
  Stream.Write(Number,SizeOf(Number));
end;

procedure WriteToStream (stream: TStream; const Number: Int64); overload;
begin
  Stream.Write(Number,SizeOf(Number));
end;
file://将filestr 写入流中
procedure WriteToStream(Stream: TStream; const Filestr: string);
var
  Count : integer;
  I : integer;
  S : Char;
begin
  Count:= length(Filestr);
  WriteToStream(Stream,Count);

  for I:= 1 to Count do begin
    S := FileStr[I];
    Stream.Write(S, 1);
  end;
end;

procedure WriteToStream (stream: TStream; const Number: Extended); overload;
begin
  Stream.Write(Number,SizeOf(Number));
end;

procedure ReadFromStream (stream: TStream; var v: Extended); overload;
begin
  Stream.Read(v,SizeOf(v)); 
end;

procedure WriteToStream(Stream: TStream; const Bool: Boolean);
begin
  Stream.Write(Bool,Sizeof(Bool));
end;

procedure WriteToStream (stream: TStream; const v: Cardinal); overload;
begin
end;

procedure WriteToStream (stream: TStream; const v: Word); overload;
begin
end;

procedure WriteToStream (stream: TStream; const v: Double); overload;
begin
  Stream.Write(V , sizeof(V));
end;


procedure ReadFromStream (stream: TStream; var v: Cardinal); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var v: Word); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var v: Double); overload;
begin
  Stream.Read(V , sizeof(v));
end;

procedure WriteToStream (stream: TStream; const sList: TStringList); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var sList: TStringList); overload;
begin
end;

procedure WriteToStream (stream: TStream; const iary: array of Integer); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var iary: array of Integer); overload;
begin
end;

function StrLike (sou: String; key: String): Boolean;
begin
  result := False;
  if pos(sou, key) > 0 then
    result := True;
end;

function SRight (s: String; n: Integer): String;
var
  I   : Integer;
begin
  Result := '';
  for I := 1 to n do begin
    Result := Result + s[I];
  end;
end;

procedure LoadFileList (Path: String; slist: TStrings; noPath: Boolean);
begin
end;

function TimeTicket: Longint;
begin
  Result := 0;
end;

function MonthOfDate (date: TDateTime): Integer;
begin
  Result := 0;
end;

function DayOfDate (date: TDateTime): Integer;
begin
  Result := 0;
end;

function YearOfDate (date: TDateTime): Integer;
begin
  Result := 0;
end;

function GetSplitWord (s: String; splitc: Char): String;
begin
end;

function HexToInt (s: String): Integer;
begin
  Result := 0;
end;

function TransStrByTable (sou: String; ori: TStringList; des: TStringList): String;
begin
end;

procedure LoadTransTable (fn: String; sou: TStringList; tag: TStringList);
begin
end;

function MakeFilePath (s: String): String;
begin
end;

function RemoveNote (s: String): String;
begin
end;

function MakePath (path: String): String;
begin
end;

function Blone (tj: String; v: String): Boolean;
begin
  Result := False;
end;

function CodeStr (s: String): String;
begin
end;

function DeCodeStr (s: String): String;
begin
end;

function GetValueFromStr (vname: String; s: String; txt: String): Boolean;
begin
  Result := False;
end;

function GetParaList (txt: String; ss: TStringList): Boolean;
begin
  Result := False;
end;

function SReplace (txt: String; sou: String; tag: String): String;
begin
end;


procedure TObjList.LoadFromStream(stream: TStream);
var
  I : integer;
  tmpCount : integer;
  tmp: TObject; 
begin
  ReadFromStream(Stream, tmpCount);
  for I:= 0 to tmpCount - 1 do begin
    Stream.Read(tmp, SizeOf(tmp));
    Add(tmp);
  end;
end;

procedure TObjList.SaveToStream(stream: TStream);
var
  I : integer;
  tmp: TObject;
begin
  WriteToStream(Stream, Count);
  for I:= 0 to Count - 1 do begin
    tmp := Items[I];
    Stream.Write(tmp, Sizeof(tmp));
  end;
end;

end.
 
 
 

qhmao
关注
  • 0
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
公共函数单元
05-12
一些delphi编程常用的单元文件 来源于长期项目积累
delphi公用函数
any2mobile的专栏
04-17 1330
{*******************************************************} { } { Delphi公用函数单元 } {
Delphi公用函数单元
weixin_30654419的博客
01-26 302
{*******************************************************} { } { Delphi公用函数单元 } { ...
delphi 公共函数
chinalog的专栏
11-10 1448
 让TDBNavigator变透明procedure TForm1.Button1Click(Sender: TObject);var  i  : Integer;  x  : Integer;begin  for i :=  DBNavigator1.ControlCount - 1 downto 0 do  begin    x :=  DBNavigator1.Left + DBNaviga
Delphi常用公用函数
05-21
根据提供的文件标题、描述、标签以及部分内容，我们可以总结出一系列与Delphi编程语言相关的实用公共函数。这些函数涉及数据处理、界面操作、过滤查询等多种功能，对于开发基于Delphi的应用程序非常有用。下面将详细...
ArcGIS Engine开发的Delphi源代码函数
03-18
文件"utGISPub.pas"很可能包含了公开的公用函数和类，供开发者在ArcGIS Engine项目中使用。这个单元可能定义了一些辅助函数，用于简化与ArcGIS Engine接口的交互，比如数据加载、地图操作、图形绘制等。通过研究这些...
自己写的函数，抽奖系统或者后续发布代码包含的公共代码库
12-17
本案例中提到的"自己写的函数，抽奖系统或者后续发布代码包含的公共代码库"，显然是一组用于抽奖系统的公用代码，可能包含了一些核心功能和辅助工具。这些公用代码库通常包含了各种通用函数和类，旨在为不同的项目...
通用公共函数（Delphi）
java开发指南博客 【转载】
07-17 184
这是我自己前两年积攒的公共函数库（Delphi7下写的）：http://www.pudn.com/dl.asp?id=945956。新版本已经做了较大变化，以后再提供。
delphi通用函数单元一
08-19
//▎============================================================▎// //▎================① 扩展的字符串操作函数 ===================▎// //▎============================================================▎// //从文件中返回Ado连接字串。 function GetConnectionString(DataBaseName:string):string; //返回服务器的机器名称. function GetRemoteServerName:string; function InStr(const sShort: string; const sLong: string): Boolean; {测试通过} {* 判断s1是否包含在s2中} function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string; {测试通过} {* 扩展整数转字符串函数 Example: IntToStrEx(1,5,'0'); 返回："00001"} function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string; {测试通过} {* 带分隔符的整数－字符转换} function ByteToBin(Value: Byte): string; {测试通过} {* 字节转二进制串} function StrRight(Str: string; Len: Integer): string; {测试通过} {* 返回字符串右边的字符 Examples: StrRight('ABCEDFG',3); 返回:'DFG' } function StrLeft(Str: string; Len: Integer): string; {测试通过} {* 返回字符串左边的字符} function Spc(Len: Integer): string; {测试通过} {* 返回空格串} function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string; {测试通过} {* 返回将指定字符s1用字符串s2替换后的字符串，可支持大小写敏感由CaseSensitive操作} {example: replace('We know what we want','we','I',false) = 'I Know what I want'} function Replicate(pcChar:Char; piCount:integer):string; {在一个字符串中查找某个字符串的位置} function StrNum(ShortStr:string;LongString:string):Integer; {测试通过} {* 返回某个字符串中某个字符串中出现的次数} function FindStr(ShortStr:String;LongStrIng:String):Integer; {测试通过} {* 返回某个字符串中查找某个字符串的位置} function SubStr(psInput:String; BeginPlace,CutLeng:Integer):String; {测试通过} {* 返回从位置BeginPlace开始切取长度为CatLeng字符串} function LeftStr(psInput:String; CutLeng:Integer):String; {测试通过} {* 返回从左边第一为开始切取 CutLeng长度的字符串} function RightStr(psInput:String; CutLeng:Integer):String; {测试通过} {* 返回从右边第一为开始切取 CutLeng长度的字符串} function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; {测试通过} {* 返回从psInput字符串左边开始用pcPadWith填充后总长度为PiWidth的字符串} function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; {测试通过} {* 返回从psInput字符串右边开始用pcPadWith填充后总长度为PiWidth的字符串} function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; {测试通过} {* 返回从psInput字符串两边开始用pcPadWith填充后总长度为PiWidth的字符串} function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String; {测试通过} {* 返回替换后字符串[替换单个字符] Examples: ChrTran('abCdEgdlkh','d','#')； 返回'abC#Eg#lkh'} function StrTran(psInput:String; psSearch:String; psTranWith:String):String; {测试通过} {* 返回替换后字符串[替换字符串] Examples: StrTran('aruyfbn','ruy','=====');； 返回'a=====fbn'} function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String; { *返回替换后字符串[替换字符串] Examples: Stuff('ABCDEFGHI',3,4,'12345')；返回'AB12345GHI'} procedure SwapStr(var s1, s2: string); {测试通过} {* 交换字串} function LinesToStr(const Lines: string): string; {测试通过} {* 多行文本转单行（换行符转'\n'）} function StrToLines(const Str: string): string; {测试通过} {* 单行文本转多行（'\n'转换行符）} function Encrypt(const S: String; Key: Word): String; {* 字符串加密函数} function Decrypt(const S: String; Key: Word): String; {* 字符串解密函数} function varIIF(aTest: Boolean; TrueValue, FalseValue: Variant): Variant; function varToStr(const V: Variant): string; {* VarIIF及VartoStr为变体函数} function IsDigital(Value: string): boolean; {功能说明：判断string是否全是数字} function RandomStr(aLength : Longint) : String; {随机字符串函数} //▎============================================================▎// //▎================② 扩展的日期时间操作函数 =================▎// //▎============================================================▎// function GetYear(Date: TDate): Integer; {测试通过} {* 取日期年份分量} function GetMonth(Date: TDate): Integer; {测试通过} {* 取日期月份分量} function GetDay(Date: TDate): Integer; {测试通过} {* 取日期天数分量} function GetHour(Time: TTime): Integer; {测试通过} {* 取时间小时分量} function GetMinute(Time: TTime): Integer; {测试通过} {* 取时间分钟分量} function GetSecond(Time: TTime): Integer; {测试通过} {* 取时间秒分量} function GetMSecond(Time: TTime): Integer; {测试通过} {* 取时间毫秒分量} function GetMonthLastDay(Cs_Year,Cs_Month:string):string; { *传入年、月，得到该月份最后一天} function IsLeapYear( nYear: Integer ): Boolean; {*/判断某年是否为闰年} function MaxDateTime(const Values: array of TDateTime): TDateTime; {//两个日期取较大的日期} function MinDateTime(const Values: array of TDateTime): TDateTime; {//两个日期取较小的日期} function dateBeginOfMonth(D: TDateTime): TDateTime; {//得到本月的第一天} function DateEndOfMonth(D: TDateTime): TDateTime; {//得到本月的最后一天} function DateEndOfYear(D: TDateTime): TDateTime; {//得到本年的最后一天} function DaysBetween(Date1, Date2: TDateTime): integer; {//得到两个日期相隔的天数} //▎============================================================▎// //▎===================③ 扩展的位操作函数 ====================▎// //▎============================================================▎// type TByteBit = 0..7; {* Byte类型位数范围} TWordBit = 0..15; {* Word类型位数范围} TDWordBit = 0..31; {* DWord类型位数范围} procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean); overload; {* 设置二进制位} procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean); overload; {* 设置二进制位} procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean); overload; {* 设置二进制位} function GetBit(Value: Byte; Bit: TByteBit): Boolean; overload; {* 取二进制位} function GetBit(Value: WORD; Bit: TWordBit): Boolean; overload; {* 取二进制位} function GetBit(Value: DWORD; Bit: TDWordBit): Boolean; overload; {* 取二进制位} //▎============================================================▎// //▎=================④扩展的文件及目录操作函数=================▎// //▎============================================================▎// function MoveFile(const sName, dName: string): Boolean; {测试通过} {* 移动文件、目录，参数为源、目标名} procedure FileProperties(const FName: string); {测试通过} {* 打开文件属性窗口} function CreatePath(path : string) : Boolean; function OpenDialog(var FileName: string; Title: string; Filter: string; Ext: string): Boolean; {* 打开文件框} function FormatPath(APath: string; Width: Integer): string; {测试通过} {* 缩短显示不下的长路径名} function GetRelativePath(Source, Dest: string): string; {测试通过} {* 取两个目录的相对路径,注意串尾不能是'\'字符！} procedure RunFile(const FName: string; Handle: THandle = 0; const Param: string = ''); {测试通过} {* 运行一个文件} function WinExecAndWait32(FileName: string; Visibility: Integer = SW_NORMAL): Integer; {测试通过} {* 运行一个文件并等待其结束} function AppPath: string; {测试通过} {* 应用程序路径} function GetDiskInfo(sFile : string; var nDiskFree,nDiskSize : Int64): boolean; {测试通过} {* 取sFile 所在磁盘空间状态 } function GetWindowsDir: string; {测试通过} {* 取Windows系统目录} function GetWinTempDir: string; {测试通过} {* 取临时文件目录} function AddDirSuffix(Dir: string): string; {测试通过} {* 目录尾加'\'修正} function MakePath(Dir: string): string; {测试通过} {* 目录尾加'\'修正} function IsFileInUse(FName: string): Boolean; {测试通过} {* 判断文件是否正在使用} function GetFileSize(FileName: string): Integer; {测试通过} {* 取文件长度} function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean; {测试通过} {* 设置文件时间 Example: FileSetDate('c:\Test\Test1.exe',753160662); } function GetFileDate(FileName: string; var CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean; {测试通过} {* 取文件时间} function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime; {测试通过} {* 文件时间转本地时间} function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime; {测试通过} {* 本地时间转文件时间} function GetFileIcon(FileName: string; var Icon: TIcon): Boolean; {测试通过} {* 取得与文件相关的图标，成功则返回True} function CreateBakFile(FileName, Ext: string): Boolean; {测试通过} {* 创建备份文件} function Deltree(Dir: string): Boolean; {测试通过} {* 删除整个目录} function GetDirFiles(Dir: string): Integer; {测试通过} {* 取文件夹文件数} type TFindCallBack = procedure(const FileName: string; const Info: TSearchRec; var Abort: Boolean); {* 查找指定目录下文件的回调函数} procedure FindFile(const Path: string; const FileName: string = '*.*'; Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True); {* 查找指定目录下文件} procedure FindFileList(Path:string;Filter,FileList:TStrings;ContainSubDir:Boolean; lb: TLabel=nil); { 功能说明：查找一个路径下的所有文件。 参数： path:路径,filter:文件扩展名过滤,FileList:文件列表, ContainSubDir:是否包含子目录} function Txtline(const txt: string): integer; {* 返回一文本文件的行数} function Html2Txt(htmlfilename: string): string; {* Html文件转化成文本文件} function OpenWith(const FileName: string): Integer; {测试通过} {* 文件打开方式} //▎============================================================▎// //▎====================⑤扩展的对话框函数======================▎// //▎============================================================▎// procedure InfoDlg(Mess: string; Caption: string = SCnInformation; Flags: Integer = MB_OK + MB_ICONINFORMATION); {测试通过} {* 显示提示窗口} function InfoOk(Mess: string; Caption: string = SCnInformation): Boolean; {测试通过} {* 显示提示确认窗口} procedure ErrorDlg(Mess: string; Caption: string = SCnError); {测试通过} {* 显示错误窗口} procedure WarningDlg(Mess: string; Caption: string = SCnWarning); {测试通过} {* 显示警告窗口} function QueryDlg(Mess: string; Caption: string = SCnInformation): Boolean; {测试通过} {* 显示查询是否窗口} procedure SetWindowAnimate(Sender : TForm; IsSetAni : bool); //▎============================================================▎// //▎=====================⑥系统功能函数=========================▎// //▎============================================================▎// procedure MoveMouseIntoControl(AWinControl: TControl); {测试通过} {* 移动鼠标到控件} function DynamicResolution(x, y: WORD): Boolean; {测试通过} {* 动态设置分辨率} procedure StayOnTop(Handle: HWND; OnTop: Boolean); {测试通过} {* 窗口最上方显示} procedure SetHidden(Hide: Boolean); {测试通过} {* 设置程序是否出现在任务栏} procedure SetTaskBarVisible(Visible: Boolean); {测试通过} {* 设置任务栏是否可见} procedure SetDesktopVisible(Visible: Boolean); {测试通过} {* 设置桌面是否可见} procedure BeginWait; {测试通过} {* 显示等待光标} procedure EndWait; {测试通过} {* 结束等待光标} function CheckWindows9598NT: string; {测试通过} {* 检测是否Win95/98/NT平台} function GetOSInfo : String; {测试通过} {* 取得当前操作平台是 Windows 95/98 还是NT} function GetCurrentUserName : string; {*获取当前Windows登录名的用户} function GetRegistryOrg_User(UserKeyType:string):string; {*获取当前注册的单位及用户名称} function GetSysVersion:string; {*//获取操作系统版本号} function WinBootMode:string; {//Windows启动模式} type PShutType = (UPowerOff, UShutdown, UReboot, ULogOff, USuspend, UHibernate); procedure WinShutDown(ShutWinType:PShutType; PForce:Boolean); {//Windows ShutDown等} //▎============================================================▎// //▎=====================⑦硬件功能函数=========================▎// //▎============================================================▎// function GetClientGUID:string; { 功能描述：在本机上得到一个GUID.去掉两端的大括号和中间的横线 返回值：去掉两端的大括号和中间的横线的一个GUID 适用范围：windows } function SoundCardExist: Boolean; {测试通过} {* 声卡是否存在} function GetDiskSerial(DiskChar: Char): string; {* 获取磁盘序列号} function DiskReady(Root: string) : Boolean; {*检查磁盘准备是否就绪} procedure WritePortB( wPort : Word; bValue : Byte ); {* 写串口} function ReadPortB( wPort : Word ) : Byte; {*读串口} function CPUSpeed: Double; {* 获知当前机器CPU的速率（MHz）} type TCPUID = array[1..4] of Longint; function GetCPUID : TCPUID; assembler; register; {*获取CPU的标识ID号*} function GetMemoryTotalPhys : Dword; {*获取计算机的物理内存} type TDriveState = (DSNODISK, DSUNFORMATTEDDISK, DSEMPTYDISK, DSDISK_WITHFILES); function DriveState (driveletter: Char) : TDriveState; {* 检查驱动器A中磁盘是否有效} //▎============================================================▎// //▎=====================⑧网络功能函数=========================▎// //▎============================================================▎// function GetComputerName:string; {* 获取网络计算机名称} function GetHostIP:string; {* 获取计算机的IP地址} function NetUserChangePassword(Domain:PWideChar; UserName:PWideChar; OldPassword:PWideChar; NewPassword:PWideChar): LongInt; stdcall; external 'netapi32.dll' name 'NetUserChangePassword'; {* // 运行平台：Windows NT/2000/XP {* // Windows 95/98/Me平台：可以用该函数修改用户的Windows登录密码} //▎============================================================▎// //▎=====================⑨汉字拼音功能函数=====================▎// //▎============================================================▎// function GetHzPy(const AHzStr: string): string; {测试通过} {* 取汉字的拼音} function HowManyChineseChar(Const s:String):Integer; {* 判断一个字符串中有多少各汉字} //▎============================================================▎// //▎===================⑩数据库功能函数及过程===================▎// //▎============================================================▎// {function PackDbDbf(Var StatusMsg: String): Boolean;} {* 物理删除数据库(Db，Dbf)中的数据[着了删除标记的记录]} procedure RepairDb(DbName: string); {* 修复Access表} function CreateODBCCfgInRegistry(ODBCSourceName:WideString;ServerName, DataBaseDescription:String):boolean; {* 通过注册表创建ODBC配置[创建在系统DSN页下]} function ADOConnectSysBase(Const Adocon:TadoConnection):boolean; {* 用Ado连接SysBase数据库函数} function ADOConnectLocalDB(Const Adocon:TadoConnection;Const Dbname,DbServerName:string;ValidateMode:Integer):boolean; {* 用Ado连接数据库函数} function ADOODBCConnectLocalDB(Const Adocon:TadoConnection;Const Dbname:string;ValidateMode:Integer):boolean; {* 用Ado与ODBC共同连接数据库函数} function CreatTable(LpDataBaseName,LpTableName,LpSentence:string):Boolean; {* //建立新表} function AddField(LpFieldName:string; LpDataType: TFieldType; LpSize: Word):string; {*//在表中添加字段} function KillField(LpFieldName:string):String; {* //在表中删除字段} function AlterTableExec(LpDataBaseName,LpSentence:string):Boolean; {* //修改表结构} function GetSQLSentence(LpTableName,LpSQLsentence:string): string; {* /修改、添加、删除表结构时的SQL句体} //▎============================================================▎// //▎======================⑾进制函数及过程======================▎// //▎============================================================▎// function StrToHex(AStr: string): string; {* 字符转化成十六进制} function HexToStr(AStr: string): string; {* 十六进制转化成字符} function TransChar(AChar: Char): Integer; //▎============================================================▎// //▎=====================⑿其它函数及过程=======================▎// //▎============================================================▎// function TrimInt(Value, Min, Max: Integer): Integer; overload; {测试通过} {* 输出限制在Min..Max之间} function IntToByte(Value: Integer): Byte; overload; {测试通过} {* 输出限制在0..255之间} function InBound(Value: Integer; Min, Max: Integer): Boolean; {测试通过} {* 判断整数Value是否在Min和Max之间} procedure CnSwap(var A, B: Byte); overload; {* 交换两个数} procedure CnSwap(var A, B: Integer); overload; {* 交换两个数} procedure CnSwap(var A, B: Single); overload; {* 交换两个数} procedure CnSwap(var A, B: Double); overload; {* 交换两个数} function RectEqu(Rect1, Rect2: TRect): Boolean; {* 比较两个Rect是否相等} procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer); {* 分解一个TRect为左上角坐标x, y和宽度Width、高度Height} function EnSize(cx, cy: Integer): TSize; {* 返回一个TSize类型} function RectWidth(Rect: TRect): Integer; {* 计算TRect的宽度} function RectHeight(Rect: TRect): Integer; {* 计算TRect的高度} procedure Delay(const uDelay: DWORD); {测试通过} {* 延时} procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1); {Win9X下测试通过} {* 只能在Win9X下让喇叭发声} procedure ShowLastError; {测试通过} {* 显示Win32 Api运行结果信息} function writeFontStyle(FS: TFontStyles; inifile: string; write: boolean):string; {* 将字体Font.Style写入INI文件} function readFontStyle(inifile: string): TFontStyles; {* 从INI文件中读取字体Font.Style文件} //function ReadCursorPos(SourceMemo: TMemo): TPoint; function ReadCursorPos(SourceMemo: TMemo): string; {* 取得TMemo 控件当前光标的行和列信息到Tpoint中} function CanUndo(AMemo: TMemo): Boolean; {* 检查Tmemo控件能否Undo} procedure Undo(Amemo: Tmemo); {*实现Undo功能} procedure AutoListDisplay(ACombox:TComboBox); {* 实现ComBoBox自动下拉} function UpperMoney(small:real):string; {* 小写金额转换为大写 } function Myrandom(Num: Integer): integer; {*利用系统时间产生随机数)} procedure OpenIME(ImeName: string); {*打开输入法} procedure CloseIME; {*关闭输入法} procedure ToChinese(hWindows: THandle; bChinese: boolean); {*打开中文输入法} //数据备份 procedure BackUpData(LpBackDispMessTitle:String); procedure ImageLoadGif(Picture: TPicture; filename: string); procedure ImageLoadJpg(Picture: TPicture; filename: string);
Delphi的一个超级函数代码库
03-29
Win32.pas API函数的简单调用，如建立进程，建立文件映射，建立、读取管道（可以捕捉DOS程序输出）等。 StrFuncs.pas 字符串处理单元，完全兼容宽字节处理（即使用wideString），特有的中文字符串处理函数（如简繁转换等等），经过多次优化，大多以编表的方式进行处理（一般来说是最快的处理方式）。 BiosHelp.pas　 读取Bios信息的单元，兼容各种windows系统。 Streams.pas　 流（TStream）输入输出处理单元，可以用来保存读取控件属性。 ShlFile.pas　 各种文件操作，包括获得系统特殊路径，获取文件图标等。 RegExpr.pas　 一个规则表达式类的单元。 ShareMemRep.pas　 一个可以用来替代Delphi本身的内存管理的单元。 MessageDlg.pas 提供了一个高制定性的消息对话框。 Lists.pas　 提供了很多个TList的扩展类，是学习很研究TList的好东西。 Calendar.pas　 公历与农历换算和时间处理的函数单元，具体看里面的说明。 Clipboards.pas 提供一个剪贴板增强类，可支持保存和载入剪贴板，支持多重剪贴板。 ComputerInfo.pas 完整的系统信息检测单元，从软件到硬件，从CPU到鼠标，很全面。 AccessCtrls.pas 一个Access数据库操作单元。 FastIniFile.pas　 可以用来替换DELPHI提供的慢吞吞的IniFiles单元，并且支持更多写入读出类型。 EnumStuff.pas 一个募举进程和窗口列表的单元，兼容各种Windows系统。 DES.pas　 DES加密算法单元。 AES.pas　 AES加密算法单元。 CryptoAPI.pas　 一个完整的Hash算法单元，如MD5、CRC之类等等。 FastMM.pas　 国外很著名的内存管理单元，Delphi2006的内存管理单元用的就是它。 FastStrings.pas　 一个快速字符串处理单元，一些函数用汇编写的，处理速度比DELPHI本身的字符串处理快很多，不过不支持WideString类型。 Idpacker.pas　 压缩文件类型检测单元。 ZLibEx.pas　 纯Pascal代码的快速压缩解压单元，压缩率和速度都不错。 FastStringFuncs.pas　 基于FastStrings.pas单元的应用。
一个包括超多函数的Delphi函数单元 MyUnit.pas文件代码.rar
07-10
与大家收集分享一个Delphi函数单元 ，文件名称为：MyUnit.pas，里面包括了超多的自定义函数，是自己在开发过程中不断丰富完善的一个函数库，文件中包括了文件压缩函数、字符串转换函数、字符过滤函数、字符串截取函数、选择文件框函数、文件类型定义函数、内存操作相关函数、驱动器判断函数、获取文件时间、Windows标准API函数、判断目录及文件夹是否存在等函数，相信在大家以后的Delphi编程中，会用到这些函数，为你省去一些麻烦，有需要的请下载本源码。
delphi比较经典的集成函数库
11-26
网上收集的delphi函数库，方便开发效率
delphi函数库(pas文件)
03-06
压缩包内含有三个文件夹 ： 函数 常用函数 常用函数库 分别放了3个PAS文件 ，可供大家参考。里面很多函数，部分为 ： 1. CustomCursor ................. 自定义光标 2. ReadRegKey ................... 读注册表键值 3. WriteRegKey .................. 写注册表键值 4. GetExePath ................... 取应用程序路径 5. GetParameter ................. 取配置文件参数 6. RebootExpires ................ 让重新启动失效 7. RebootRestore ................ 恢复重新启动功能 8. CloseExpires ................. 使窗口关闭功能失效 9. CloseRestore ................. 恢复窗口关闭功能 等等
Delphi单元--共50个函数
weixin_34123613的博客
01-07 308
unit tools;interfaceuses windows,Forms,mmsystem,winsock,sysutils,classes,controls,messages,activex, shlobj,menus,comobj,jpeg,graphics,extctrls,ShellApi,contnrs,dialogs;constSHFMT_ID_DEFAULT=...
delphi 函数大全
yethyeth的专栏
12-23 2270
  Delphi6函数大全（1）   > 首部 function AnsiResemblesText(const AText, AOther: string): Boolean; $[Str
我的公共函数单元（Delphi）
Hsu Chong 的专栏
03-13 2078
 
Delphi公共函数（一）
平民
12-22 2146
//摘自Kendys Blog{    使用方法, uses 本单元——>使用如:Pub.MsgBox(你好，欢迎使用本公用函数！);                                     ShowMessage(Pub.PathExeDir); }//////////////////////以下源码开始{$DEFINE Delphi7}//D5下不要此句unit PubF
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值