西出阳关

因为名字里面有个阳字,莫名就喜欢上了那句"西出阳关无故人"的意境.

日历
网志分类
· 所有网志
· flash研究
· delphi 编程
· 个人随想
· 未分类
站内搜索
友情链接
· 歪酷博客
· 管理我的Blog
 交流空间

歪酷博客

订阅 RSS

0011025

歪酷博客

« 上一篇: 顺利搞掂歪酷的模板 下一篇: delphi编错纠错 »
阳子 @ 2005-06-20 20:15

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 = {post.content}07c088;
 IOCTL_SCSI_MINIPORT = {post.content}04d008;
 IOCTL_SCSI_MINIPORT_IDENTIFY = {post.content}1b0501;
 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.

阅读全文(624) / 评论 / 扔小纸条 / 给阳子留言
收藏: QQ书签 del.icio.us

评论 / 个人网页 / 扔小纸条
*昵称

已经注册过? 请登录
Email
网址
*评论