delphi的一个公用函数库

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.
 
 
 

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
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单元的应用。
function CapitalizeMoney(aMoney: Double; aIsUnit: Boolean; var oMoneyStr: string): string; //小写人民币转换成大写人民币 function IsExistForm(aFormObject: string): Boolean; //查询窗体是否存在 function CalcAmountOfField(aQry: TQuery; aFieldName: string; var oAmountStr: string): string; //计算合计 function ChangeChineseToPY(aChinese: string; aIsCapital: Boolean; var oPYStr: string): string; //汉字转换成拼音码 function TrimTextOfEdt(aFormObject: TForm): string; //清除Form上EDIT的前后空格 function ClearTextOfEdt(aFormObject: TForm): string; //清除Form上EDIT的内容 function ClearCaptionOfPnl(aFormObject: TForm): string; //清除Form上Panel的内容 function SetReadOnlyOfEdt(aFormObject: TForm; aIs: Boolean): string; // 使FORM上EDIT不可写 function FullItemOfCB(aQry: TQuery; aFieldName: string; aCBObject: TComBoBox): string; //填充ComBoBox中的内容 function FullItemOfLB(aQry: TQuery; aFieldName: string; aLBObject: TListBox): string; //填充ListBox中的内容 function FilterQry(aQry: TQuery; aFieldName: string; aFilterValue: string): string; //对单个字段的过滤 function FilterPiPeiMa(aQry: TQuery; aFilterValue: string): string; //对拼音码,五笔码,自定码的组合过滤 function FilterQryByDBG(aQry: TQuery; aDBGrid: TDBGrid; aFilterValue: string): string; //对DBGrid的指定列的过滤 function LocateQryByDBG(aQry: TQuery; aDBGrid: TDBGrid; aLocateValue: string): string; //对DBGrid的指定列的定位 function SetLocalTimeForServerTime(aQry: TQuery): string; //设置本机时间为服务器时间 function SwapQueryRecord(aIsUp: Boolean; var oQry: TQuery): string; //交换记录 // function GetPaperSize(aPaperSizeStr: string): TQRPaperSize; function GetQRBandType(aQRBandTypeStr: string): TQRBandType; function GetAlignment(aAlignmentStr: string): TAlignment; function GetBoolean(aBooleanStr: string): Boolean; function GetColor(aColorStr: string): TColor; function GetFontStyle(aFontStyleStr: string): TFontStyles; function GetDataType(aDataTypeStr: string): TQRSysDataType; function GetPageOptions(aOptionStr: string): TQuickReportOptions; function GetPageOrientation(aOrientationStr: string): TPrinterOrientation;
//文件操作部分起 //拷贝一个文件,封装CopyFile procedure FileCopyFile(const sSrcFile, sDstFile: string); //给定路径复制文件到同一目录下 bRecursive:true所有 procedure FileCopyDirectory(sDir, tDir: string; bRecursive: Boolean);overload; //给定路径原样复制文件 ,自编 procedure FileCopyDirectory(sDir, tDir: string);overload; //给定路径原样复制文件 ,用WinAPI ,若原目录下有相同文件则再生成一个 procedure FileCopyDirectory(sDir, tDir:string;AHandle:Thandle);overload; //移动文件夹 procedure FileMoveDirectory(sDir, tDir:string;AHandle:Thandle); //删除给定路径及以下的所有路径和文件 procedure FileDeleteDirectory(sDir: string);overload; //删除给定路径及以下的所有路径和文件 用WinApi procedure FileDeleteDirectory(AHandle: THandle;const ADirName: string);overload; //删除给定路径及以下的所有路径和文件 到回收站 procedure FileDeleteDirectoryToCycle(AHandle: THandle;const ADirName: string); //取得指定文件的大小 function FileGetFileSize(const Filename: string): DWORD; //在Path下取得唯一FilenameX文件 function FileGetUniqueFileName(const Path: string; Filename: string): string; //取得临时文件 function FileGetTemporaryFileName: string; //取得系统路径 function PathGetSystemPath: string; //取得Windows路径 function PathGetWindowsPath: string; //给定文件名取得在系统目录下的路径,复制时用 function PathSystemDirFile(const Filename: string): string; //给定文件名取得在Windows目录下的路径,复制时用 function PathWindowsDirFile(const Filename: string): string; //给定文件名取得在系统盘下的路径,复制时用 function PathSystemDriveFile(const Filename: string): string; //路径最后有'/'则去'/' function PathWithoutSlash(const Path: string): string; //路径最后没有'/'则加'/' function PathWithSlash(const Path: string): string; //取得两路径的不同部分,条件是前半部分相同 function PathRelativePath(BaseDir, FilePath: string): string; //取得去掉属性的路径,文件名也作为DIR function PathExtractFileNameNoExt(Filename: string): string; //判断两路径是否相等 function PathComparePath(const Path1, Path2: string): Boolean; //取得给定路径的父路径 function PathParentDirectory(Path: string): string; //分割路径,Result=根(如d:)sPath = 除根外的其他部分 function PathGetRootDir(var sPath: string): string; //取得路径最后部分和其他部分 如d:\aa\aa result:=aa sPath:=d:\aa\ function PathGetLeafDir(var sPath: string): string; //取得当前应用程序的路径 function PathExeDir(FileName: string = ''): string; //文件操作部分止 //系统处理起 //提示窗口 procedure MsgBox(const Msg: string); //错误显示窗口 procedure MsgErrBox(const Msg: string); //询问窗口 带'是','否'按钮 function MsgYesNoBox(const Msg: string): Boolean; //询问窗口 带'是','否,'取消'按钮//返回值smbYes,smbNo,smbCancel function MsgYesNoCancelBox(const Msg: string): Integer; //使鼠标变忙和恢复正常 procedure DoBusy(Busy: Boolean); //显示错误信息 procedure ShowLastError(const Msg: string = 'API Error'); //发出错误信息 procedure RaiseLastError(const Msg: string = 'API Error'); //释放Strings连接的相关资源 procedure FreeStringsObjects(SL: TStrings); //系统处理止 //时间处理起 //整数到时间 function TimeT_To_DateTime(TimeT: Longint): TDateTime; //转化为秒 function TimeToSecond(const H, M, S: Integer): Integer; //秒转化 procedure TimeSecondToTime(const secs: Integer; var H, M, S: Word); //秒转化 function TimeSecondToTimeStr(secs: Integer): string; //时间处理止 //控件处理起 //设置控件是否能使用 procedure ConEnableControl(AControl: TControl; Enable: Boolean); //设置控件是否能使用,包子控件 procedure ConEnableChildControls(AControl: TControl; Enable: Boolean); procedure ConEnableClassControl(AControl: TControl; Enable: Boolean; ControlClass: TControlClass); procedure ConFree(aCon: TWinControl);//释放aCon上的控件 //从文件本中导入,类似LoadfromFile procedure ConLoadTreeViewFromTextFile(Nodes: TTreeNodes; Filename: string); //存为文本,类似SaveToFile procedure ConSaveTreeViewToTextFile(Nodes: TTreeNodes; Filename: string); //在控件上写文本 procedure ConWriteText(aContr: TControl;sText: string); //控件处理止 //字符串处理起 //取以Delimiters分隔的字符串 bTrail如果为True则把第index个后的也取出来 function StrGetToken(const S: string; index: Integer; bTrail: Boolean = False; Delimiters: TSysCharSet = DEFAULT_DELIMITERS): string; //取以Delimiters分隔的字符串的个数 function StrCountWords(S: string; Delimiters: TSysCharSet = DEFAULT_DELIMITERS): Integer; //用NewToken替换S中所有Token bCaseSensitive:=true大小写敏感 function StrReplaceString(var S: string; const Token, NewToken: string; bCaseSensitive: Boolean): Boolean; //从第Index个起以Substr替换Count个字符 procedure StrSimple_ReplaceString(var S: string; const Substr: string; index, Count: Integer); //去掉S中的回车返行符 procedure StrTruncateCRLF(var S: string); //判定S是否以回车返行符结束 function StrIsContainingCRLF(const S: string): Boolean; //把SL中的各项数据转化为以Delimiter分隔的Str function StrCompositeStrings(SL: TStrings; const Delimiter: string): string; //封装TStrings的LoadFromFile function StrSafeLoadStrings(SL: TStrings; const Filename: string): Boolean; //封装TStrings的SaveToFile procedure StrSafeSaveStrings(SL: TStrings; const Filename: string); //字符串处理止 //字体处理起 procedure StringToFont(sFont: string; Font: TFont; bIncludeColor: Boolean = True); function FontToString(Font: TFont; bIncludeColor: Boolean = True): string; //字体处理止 //网络起 //判定是否在线 function NetJudgeOnline:boolean; //得到本机的局域网Ip地址 Function NetGetLocalIp(var LocalIp:string): Boolean; //通过Ip返回机器名 Function NetGetNameByIPAddr(IPAddr: string; var MacName: string): Boolean ; //获取网络中SQLServer列表 Function NetGetSQLServerList(var List: Tstringlist): Boolean; //获取网络中的所有网络类型 Function NetGetNetList(var List: Tstringlist): Boolean; //获取网络中的工作组 Function NetGetGroupList(var List: TStringList): Boolean; //获取工作组中所有计算机 Function NetGetUsers(GroupName: string; var List: TStringList): Boolean; //获取网络中的资源 Function NetGetUserResource(IpAddr: string; var List: TStringList): Boolean; //映射网络驱动器 Function NetAddConnection(NetPath: Pchar; PassWord: Pchar;LocalPath: Pchar): Boolean; //检测网络状态 Function NetCheckNet(IpAddr:string): Boolean; //检测机器是否登入网络 Function NetCheckMacAttachNet: Boolean; //判断Ip协议有没有安装 这个函数有问题 Function NetIsIPInstalled : boolean; //检测机器是否上网 Function NetInternetConnected: Boolean; //网络止 //窗口起 function FormCreateProcessFrm(MsgTitle: string):TForm; //窗口止 //EMail起 function CheckMailAddress(Text: string): boolean; //EMail止

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值