delphi的一个公用函数库 _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.