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[..] of Longint;

 TVendor = array [..] 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 := ;

  for I := n downto  do begin

    c := PreId[I];

    if  (Ord(c) >= ) and (Ord(c) <= ) then begin

       n1 := I;

       Break;

    end;

  end;

  s := Copy(PreId, , n1);

  s1 := Copy(PreId, n1 + , );

  s1 := IntToStr(StrInt(s1) + );

  result := s1;

  for I :=  to  n - n1 - Length(s1) do

    Result := '' + Result;

  result := s + Result;

end;

file://不能输入字符

function CheckNullValue(var Key: Char): Boolean;

const

  ControlKeySet = [Char(#)];

begin

  Key := #;

  Result := True;

end;

{判断输入的字符是否是数字}

function CheckInputNum(const IsInteger: Boolean; AStr: string; var Key: Char): Boolean;

const

  NumberSet = ['' .. '', '.', '-'];

  ControlKeySet = [Char(#), Char(#)];

begin

  if Key in ControlKeySet then begin

    Result := True;

    Exit;

  end;

  if not (Key in NumberSet) then Key := #;

  if (Key = '.') and ((Length(AStr) = ) or (Pos('.', AStr) > )) then

    Key := #;

  file://不能前两个同时为0

  if (Length(AStr) = ) and (AStr[] = '') and (Key = '') then Key := #;

  file://不能有多个负号

  if (Pos('-', AStr) >= ) and (Key = '-') then Key := #;

  if IsInteger then begin

    if key = '.' then Key := #;

//    if (Length(AStr) = 1) and (AStr[1] = '0') or (Key = '.') then Key := #0;

  end;

  Result := Key <> #;

end;

{日期型字段显示过程,在OnGetText事件中调用}

procedure DateFieldGetText(Sender: TField; var Text: String);

var

  dDate: TDate;

  wYear,wMonth,wDay: Word;

  aryTestYMD: Array [..] of Char ;{测试输入掩码用临时数组}

  iYMD: Integer;

begin

  iYMD := ;

  dDate:= Sender.AsDateTime;

  DecodeDate(dDate,wYear,wMonth,wDay);

  {测试输入掩码所包含的格式.}

  aryTestYMD:= '年';

  if StrScan(PChar(Sender.EditMask), aryTestYMD[]) <> nil then iYMD:= ;

  aryTestYMD:= '月';

  if StrScan(PChar(Sender.EditMask), aryTestYMD[]) <> nil then iYMD:= ;

  aryTestYMD:= '日';

  if StrScan(PChar(Sender.EditMask), aryTestYMD[]) <> nil then iYMD:= ;

  case iYMD of

    :{输入掩码为:”yyyy年”的格式.}

    Text:= IntToStr(wYear) + '年';

    : {输入掩码为:”yyyy年mm月”的格式.}

    Text:= IntToStr(wYear) + '年' + IntToStr(wMonth) + '月';

    : {输入掩码为:”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 [..] of Char;

  iYMD: Integer;

begin

  iYMD := ;

{获得用户输入的日期}

  sYear := Copy(Text, , );

  sMonth:= Copy(Text, , );

  SDay  := Copy(Text, , );

{测试输入掩码所包含的格式.}

  aryTestYMD := '年';

  if StrScan( PChar(Sender.EditMask), aryTestYMD[] ) <> nil then iYMD := ;

  aryTestYMD := '月';

  if StrScan( PChar(Sender.EditMask), aryTestYMD[] ) <> nil then iYMD := ;

  aryTestYMD := '日';

  if StrScan( PChar(Sender.EditMask), aryTestYMD[] ) <> nil then iYMD := ;

  {利用Try…Except进行输入的日期转换}

  try begin

    case iYMD of

      : {输入掩码为:”yyyy年”的格式.}

        begin

        dDate := StrToDate( sYear + '-01-01' );{中文Windows默认的日期格式为:yyyy-mm-dd.下同}

        Sender.AsDateTime := dDate;

        end;

      : {输入掩码为:”yyyy年mm月”的格式.}

        begin

        dDate := StrToDate( sYear + '-' + sMonth + '-01' );

        Sender.AsDateTime:=dDate;

        end;

      : {输入掩码为:”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 [..] of char;

  tmpstr: string;

begin

  tmpstr := '';

  hWnd := WindowFromPoint(Sender);

  tmpstr := 'Handle : ' + IntToStr(hWnd);

  if boolean(GetClassName(hWnd, aName, )) 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 := ;

  Randomize;

  If Num =  then Exit;

  GetSystemTime(T);

  X := Trunc(T.wMilliseconds/) * T.wSecond * ;

  X := X + random();

  if X <  then X := -X;

  X := Random(X);

  X := X mod num;

  for I :=  to X do

    X := Random(Num);

  Result := X;

end;

function GetCurrentUserName : string;

const

  cnMaxUserNameLen = ;

var

  sUserName : string;

  dwUserNameLen : Dword;

begin

  dwUserNameLen := cnMaxUserNameLen-;

  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,

  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,

  DW      $A20F    {CPUID Command}

  MOV     EAX,EBX

  XCHG  EBX,ECX     {save ECX result}

  MOV   ECX,

@:

  STOSB

  SHR     EAX,

  LOOP    @

  MOV     EAX,EDX

  MOV   ECX,

@:

  STOSB

  SHR     EAX,

  LOOP    @

  MOV     EAX,EBX

  MOV   ECX,

@:

  STOSB

  SHR     EAX,

  LOOP    @

  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] := -;

    CPUID := GetCPUID;

  Result := Result + IntToHex(CPUID[],);

  Result := Result + IntToHex(CPUID[],);

  Result := Result + IntToHex(CPUID[],);

  Result := Result + IntToHex(CPUID[],);

  S := GetCPUVendor;

  Result := Result + S;

end;

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

  type

    TSrbIoControl = packed record

    HeaderLength : ULONG;

    Signature : Array[..] 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[..] of Byte;

    dwReserved : Array[..] of DWORD;

    bBuffer : Array[..] 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[..] of Word;

    sSerialNumber : Array[..] of Char;

    wBufferType : Word;

    wBufferSize : Word;

    wECCSize : Word;

    sFirmwareRev : Array[..] of Char;

    sModelNumber : Array[..] 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[..] of Byte;

  end;

  PIdSector = ^TIdSector;

const

  IDE_ID_FUNCTION = $EC;

  IDENTIFY_BUFFER_SIZE = ;

  DFP_RECEIVE_DRIVE_DATA = $0007c088;

  IOCTL_SCSI_MINIPORT = $0004d008;

  IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501;

  DataSize = sizeof(TSendCmdInParams)-+IDENTIFY_BUFFER_SIZE;

  BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;

  W9xBufferSize = IDENTIFY_BUFFER_SIZE+;

var

  hDevice : THandle;

  cbBytesReturned : DWORD;

  pInData : PSendCmdInParams;

  pOutData : Pointer; // PSendCmdOutParams

  Buffer : Array[..BufferSize-] of Byte;

  srbControl : TSrbIoControl absolute Buffer;

  procedure ChangeByteOrder( var Data; Size : Integer );

  var

    ptr : PChar;

    i : Integer;

    c : Char;

  begin

    ptr := @Data;

    for i :=  to (Size shr )- do begin

      c := ptr^;

      ptr^ := (ptr+)^;

      (ptr+)^ := c;

      Inc(ptr,);

     end;

  end;

begin

  Result := '';

  FillChar(Buffer,BufferSize,#);

  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, ,  );

    if hDevice=INVALID_HANDLE_VALUE then Exit;

    try

      srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);

      System.Move('SCSIDISK',srbControl.Signature,);

      srbControl.Timeout := ;

      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 := ;

        with irDriveRegs do begin

          bFeaturesReg := ;

          bSectorCountReg := ;

          bSectorNumberReg := ;

          bCylLowReg := ;

          bCylHighReg := ;

          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', , , nil, CREATE_NEW, ,  );

    if hDevice=INVALID_HANDLE_VALUE then Exit;

    try

      pInData := PSendCmdInParams(@Buffer);

      pOutData := @pInData^.bBuffer;

      with pInData^ do begin

        cBufferSize := IDENTIFY_BUFFER_SIZE;

        bDriveNumber := ;

        with irDriveRegs do begin

          bFeaturesReg := ;

          bSectorCountReg := ;

          bSectorNumberReg := ;

          bCylLowReg := ;

          bCylHighReg := ;

          bDriveHeadReg := $A0;

          bCommandReg := IDE_ID_FUNCTION;

        end;

      end;

      if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA,

            pInData, SizeOf(TSendCmdInParams)-, pOutData,

            W9xBufferSize, cbBytesReturned, nil ) then Exit;

    finally

      CloseHandle(hDevice);

    end;

  end;

  with PIdSector(PChar(pOutData)+)^ 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 :=  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 :=  to N -  do begin

    Result := Result * ;

  end;

  Result := Round(Result);

  for I :=  to N -  do begin

    Result := Result / ;

  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 =  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 := ;

  for I :=  to length(s) do begin

    if (ord(s[I]) > ) or (ord(s[I]) < ) then begin

      if ord(s[I]) <>  then begin

        B := False;

        Break;

      end;

    end;

  end;

  if B and (Length(s) <> ) 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 := ;

  for I :=  to N do begin

    Max := Max * ;

  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 := ;

  if s = '' then begin

    result := ;

    Exit;

  end;

  for I :=  to length(s) do begin

    if (ord(s[I]) > ) or (ord(s[I]) < ) then begin

      B := False;

      Break;

    end;

  end;

  if B and (Length(s) <> ) 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 := ;

  ReadFromStream(Stream, Count);

  for I :=  to Count do begin

    Stream.Read(S, );

    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:=  to Count do begin

    S := FileStr[I];

    Stream.Write(S, );

  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) >  then

    result := True;

end;

function SRight (s: String; n: Integer): String;

var

  I   : Integer;

begin

  Result := '';

  for I :=  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 := ;

end;

function MonthOfDate (date: TDateTime): Integer;

begin

  Result := ;

end;

function DayOfDate (date: TDateTime): Integer;

begin

  Result := ;

end;

function YearOfDate (date: TDateTime): Integer;

begin

  Result := ;

end;

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

begin

end;

function HexToInt (s: String): Integer;

begin

  Result := ;

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:=  to tmpCount -  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:=  to Count -  do begin

    tmp := Items[I];

    Stream.Write(tmp, Sizeof(tmp));

  end;

end;

end.

delphi的一个公用函数库的更多相关文章

  1. Delphi另一个多线程函数：BeginThread用法

    Delphi另一个多线程函数:BeginThread━━━━━━━━━━━━━━━━━━━━━━━━━━ Delphi也提供了一个相同功能的类似函数:function BeginThread(    ...

  2. 一个ASP函数库

    <% '****************************** '类名: '名称:通用库 '日期:2008/10/28 '作者:by xilou '网址: '描述:通用库 '版权:转载请注 ...

  3. linux 函数库使用

    程序函数库可分为3种类型:静态函 数库(static libraries).共享函数库(shared libraries)和动态加载函数库(dynamically loaded libraries) ...

  4. [UE4]蓝图函数库小结

    蓝图函数库的功能非常强劲,如果在项目中使用的话有时能达到事半功倍的效果. 蓝图函数库,Blueprint Function Library.可以非常方便的将代码中的函数暴露给所有的蓝图使用,同时也提供 ...

  5. MySQL函数库

    MySQL函数库,这个函数库是一个外部函数库!这个函数提供了对于MySQL数据库进行操作的常用函数,如连接MySQL服务器.打开数据库.执行SQL语句等.所以这个函数库的功能对于我们来说是非常重要的! ...

  6. Underscore——JS函数库

    转载请注明原文地址:https://www.cnblogs.com/ygj0930/p/10826065.html underscore是什么——它是一个js函数库 jQuery统一了不同浏览器之间的 ...

  7. delphi公用函数

    {*******************************************************} { } { Delphi公用函数单元 } { } { 版权所有 (C) 2008 } ...

  8. 如何持续集成/交付一个开源.NET函数库到Nuget.org

    (此文章同时发表在本人微信公众号"dotNET每日精华文章",欢迎右边二维码来关注.) 题记:这是一个简单的入门向导,涉及到GitHub.AppVeyor和Nuget.org. 最 ...

  9. 自己的一个LESS工具函数库

    自己大概在一年前开始使用LESS编写样式,现在感觉不用LESS都不会写样式了.现在写静态页面完全离不开LESS与Zen Coding,我可以不用什么IDE,但这两个工具却必须要,当然也强烈推荐看到这篇 ...

随机推荐

  1. ros卸载

    sudo apt-get purge ros-*sudo rm -rf /etc/rossudo rm -rf /opt/ros删除.bashrc中的source /opt/ros/indigo/se ...

  2. Zabbix 3.4.2 install && Configuration

    原理: 1)zabbix server:负责接收agent发送的报告信息的核心组件,所有配置.统计数据及操作数据都由它组织进行: 2)database storage:专用于存储所有配置信息,以及由z ...

  3. 暂停线程执行sleep_yield_join_stop

    1.final void join() 调用该方法的线程强制执行完成,其它线程处于阻塞状态,该线程执行完毕,其它线程再执行 public class TestJoin { public static ...

  4. java 日期与时间类

    1.Date类:  https://www.cnblogs.com/huangminwen/p/5994927.html 2.DateFormat和SimpleDateFormat (simple简单 ...

  5. docker数据卷管理及网络基础配置

    数据卷 数据卷容器 数据卷迁移数据 端口映射 容器间通信 数据卷的管理 当需要查看容器内应用产生的数据或者把容器内数据备份及多个容器数据共享.有两种方式,数据卷以及数据卷容器. 数据卷 数据卷是一个可 ...

  6. php实现一个单链表

    单链表,节点只有一个指针域的链表.节点包括数据域和指针域. 因此用面向对象的思维,节点类的属性就有两个:一个data(表示存储的数据),一个指针next(链表中指向下一个节点). 链表一个很重要的特性 ...

  7. MFC入门（一）-- 第一个简单的windows图形化界面小程序（打开计算器，记事本，查IP）

    ////////////////////////////////序//////////////////////////////// 大约三年前,学过一些简单的编程语言之后其实一直挺苦恼于所写的程序总是 ...

  8. How to Enable TLS 1.2 on Windows Server 2008 R2 and IIS 7.5

    Nowadays there is an SSL vulnerability called POODLE discovered by Google team in SSLv3 protocol. So ...

  9. TRIO-basic指令--MOVEMODIFY

    Syntax: MOVEMODIFY(position) Parameters: position: Absolute position for the current move to complet ...

  10. kvm虚拟化管理平台WebVirtMgr部署-完整记录(0)

    打算部署kvm虚拟机环境,下面是虚拟化部署前的一些准备工作: 操作系统环境安装1)修改内核模式为兼容内核启动[root@ops ~]# uname -aLinux openstack 2.6.32-4 ...