ustring.pas

用delphi开发的资料室图书借阅管理系统

 FreeMem(Buffer);
 CloseHandle(ProcessInfo.hProcess);
 CloseHandle(ProcessInfo.hThread);
 CloseHandle(ReadPipe);
 CloseHandle(WritePipe);
 end;
end;
 //--------------------------------------------------------------------------------------------------
  Function Get_nodeName(strnodeText:string):string;
      var ps2:integer;
  begin
        ps2:=pos(']',strnodeText);
       result:=trim(copy(strnodeText,ps2+1,length(strnodeText)-ps2));
  end;
  //--------------------------------------------------------------------------------------------
 procedure Exp_Treeview(TV:TSeSkinSTreeView;SaveDia:TSaveDialog;file_Name:string);
       var fileExt:string;
   begin
        savedia.Filter:='Microsoft Excel Workbook (*.xls)|*.XLS|Comma separated values (*.csv)|*.CSV|Text files (*.txt)|*.TXT|HTML file (*.htm)|*.HTM|Rich Text Format (*.rtf)|*.RTF';
        SaveDia.FileName := DateTostr(date)+'  '+file_Name;
  if SaveDia.Execute then
    begin  //*****************************************************
      case SaveDia.FilterIndex of  //-------------------------------------
        1: begin fileExt := 'xls'; end;
        2: begin fileExt := 'csv'; end;
        3: begin fileExt := 'txt'; end;
        4: begin fileExt := 'htm'; end;
        5: begin fileExt := 'rtf'; end;
      else
         fileExt := '';
      end;    //-------------------------------------
      if UpperCase(ExtractFileExt(trim(SaveDia.FileName)))<>UpperCase(fileExt) then
          SaveDia.FileName := SaveDia.FileName + '.' + fileExt;
       try
           TV.SaveToFile(SaveDia.FileName);
           Application.MessageBox(pchar('数据成功导出到'+
            #13+SaveDia.FileName),'导出成功',mb_ok+mb_iconinformation);
          except on E:Exception
          do
            Application.MessageBox(pchar('数据导出失败！'),'提醒',mb_ok+mb_iconinformation);
          end;
   end; //*****************************************************
   end;
  //------------------------------------------------------------------------------------------
    //获取第一个IDE硬盘的序列号
function GetIdeSerialNumber : pchar;
const IDENTIFY_BUFFER_SIZE = 512;
type
   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 for future use.  Must be zero.
  end;
  TSendCmdInParams = packed record
    // Buffer size in bytes
    cBufferSize  : DWORD;
    // Structure with drive register values.
    irDriveRegs  : TIDERegs;
    // Physical drive number to send command to (0,1,2,3).
    bDriveNumber : BYTE;
    bReserved    : Array[0..2] of Byte;
    dwReserved   : Array[0..3] of DWORD;
    bBuffer      : Array[0..0] of Byte;  // Input buffer.
  end;
  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    : DWORD;
    wMultSectorStuff           : Word;
    ulTotalAddressableSectors  : DWORD;
    wSingleWordDMA             : Word;
    wMultiWordDMA              : Word;
    bReserved                  : Array[0..127] of BYTE;
  end;
  PIdSector = ^TIdSector;
  TDriverStatus = packed record
    // 驱动器返回的错误代码，无错则返回0
    bDriverError : Byte;
    // IDE出错寄存器的内容，只有当bDriverError 为 SMART_IDE_ERROR 时有效
    bIDEStatus   : Byte;
    bReserved    : Array[0..1] of Byte;
    dwReserved   : Array[0..1] of DWORD;
  end;
  TSendCmdOutParams = packed record
    // bBuffer的大小
    cBufferSize  : DWORD;
    // 驱动器状态
    DriverStatus : TDriverStatus;
    // 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
    bBuffer      : Array[0..0] of BYTE;
  end;
  var hDevice : THandle;
      cbBytesReturned : DWORD;
      ptr : PChar;
      SCIP : TSendCmdInParams;
      aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
      IdOutCmd  : TSendCmdOutParams absolute aIdOutCmd;
  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 := ''; // 如果出错则返回空串
    if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then begin// Windows NT, Windows 2000
        // 提示! 改变名称可适用于其它驱动器，如第二个驱动器： '\\.\PhysicalDrive1\'
        hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
          FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
    end else // Version Windows 95 OSR2, Windows 98
      hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
      if hDevice=INVALID_HANDLE_VALUE then Exit;
     try
      FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
      FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
      cbBytesReturned := 0;
      // Set up data structures for IDENTIFY command.
      with SCIP do begin
        cBufferSize  := IDENTIFY_BUFFER_SIZE;
  //      bDriveNumber := 0;
        with irDriveRegs do begin
          bSectorCountReg  := 1;
          bSectorNumberReg := 1;
  //      if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
  //      else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
          bDriveHeadReg    := $A0;
          bCommandReg      := $EC;
        end;
      end;
      if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
        @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
    finally
      CloseHandle(hDevice);
    end;
    with PIdSector(@IdOutCmd.bBuffer)^ do begin
      ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
      (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
      Result := PChar(@sSerialNumber);
    end;
  end;

 function Encrypt(s0: String): String;
  var j,k:integer;
      str_Auto1,str_Auto2:String;

  begin
     k:=length(s0);
     for j:=1 to k do
     begin
          {
0	8
1	I
2	R
3	9
4	S
5	N
6	0
7	T
8	J
9	2
A	M
B	U
C	7
D	H
E	1
F	L
G	A
H	3
I	G
J	V
K	K
L	W
M	6
N	F
O	X
P	B
Q	Y
R	4
S	Z
T	5
U	Q
V	D
W	O
X	C
Y	P
Z	E}

      if  s0[j]='0' then  s0[j]:='8'
    else  if  s0[j]='1' then  s0[j]:='I'
    else  if  s0[j]='2' then  s0[j]:='R'
    else  if  s0[j]='3' then  s0[j]:='9'
    else  if  s0[j]='4' then  s0[j]:='S'
    else  if  s0[j]='5' then  s0[j]:='N'
    else  if  s0[j]='6' then  s0[j]:='O'
    else  if  s0[j]='7' then  s0[j]:='T'
    else  if  s0[j]='8' then  s0[j]:='J'
    else  if  s0[j]='9' then  s0[j]:='2'
    else  if  s0[j]='A' then  s0[j]:='M'
    else  if  s0[j]='B' then  s0[j]:='U'
    else  if  s0[j]='C' then  s0[j]:='7'
    else  if  s0[j]='D' then  s0[j]:='H'
    else  if  s0[j]='E' then  s0[j]:='1'
    else  if  s0[j]='F' then  s0[j]:='L'
    else  if  s0[j]='G' then  s0[j]:='A'
    else  if  s0[j]='H' then  s0[j]:='3'
    else  if  s0[j]='I' then  s0[j]:='G'
    else  if  s0[j]='J' then  s0[j]:='V'
    else  if  s0[j]='K' then  s0[j]:='K'
    else  if  s0[j]='L' then  s0[j]:='W'
    else  if  s0[j]='M' then  s0[j]:='6'
    else  if  s0[j]='N' then  s0[j]:='F'
    else  if  s0[j]='O' then  s0[j]:='X'
    else  if  s0[j]='P' then  s0[j]:='B'
    else  if  s0[j]='Q' then  s0[j]:='Y'
    else  if  s0[j]='R' then  s0[j]:='4'
    else  if  s0[j]='S' then  s0[j]:='Z'
    else  if  s0[j]='T' then  s0[j]:='5'
    else  if  s0[j]='U' then  s0[j]:='Q'
    else  if  s0[j]='V' then  s0[j]:='D'
    else  if  s0[j]='W' then  s0[j]:='0'
    else  if  s0[j]='X' then  s0[j]:='C'
    else  if  s0[j]='Y' then  s0[j]:='P'
    else  if  s0[j]='Z' then  s0[j]:='E' ;

     end;
      
     str_Auto1:=S0[3]+S0[5]+S0[2]+S0[1]+S0[4];


     result:=str_Auto1;
  end;

 function ShowHostName:string;
var
  wVersionRequested : WORD;
  wsaData : TWSAData;
  p : PHostEnt;
  s : array[0..128] of char;
  p2 : pchar;
begin
{启动 WinSock}
  wVersionRequested := MAKEWORD(1, 1);
  WSAStartup(wVersionRequested, wsaData);
{计算机名}
  GetHostName(@s, 128);
  p := GetHostByName(@s);
{IP地址}
  p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
  WSACleanup;
  result:=p2;
end;
//-----------------------------------------------------------------------------
function  Encrypt0(s0: String): String;
  var j,k:integer;
      str_Auto1,str_Auto2:String;

  begin
     k:=length(s0);
     for j:=1 to k do
     begin
          {
0	8
1	I
2	R
3	9
4	S
5	N
6	0
7	T
8	J
9	2
A	M
B	U
C	7
D	H
E	1
F	L
G	A
H	3
I	G
J	V
K	K
L	W
M	6
N	F
O	X
P	B
Q	Y
R	4
S	Z
T	5
U	Q
V	D
W	O
X	C
Y	P
Z	E}

      if  s0[j]='0' then  s0[j]:='8'
    else  if  s0[j]='1' then  s0[j]:='I'
    else  if  s0[j]='2' then  s0[j]:='R'
    else  if  s0[j]='3' then  s0[j]:='9'
    else  if  s0[j]='4' then  s0[j]:='S'
    else  if  s0[j]='5' then  s0[j]:='N'
    else  if  s0[j]='6' then  s0[j]:='O'
    else  if  s0[j]='7' then  s0[j]:='T'
    else  if  s0[j]='8' then  s0[j]:='J'
    else  if  s0[j]='9' then  s0[j]:='2'
    else  if  s0[j]='A' then  s0[j]:='M'
    else  if  s0[j]='B' then  s0[j]:='U'
    else  if  s0[j]='C' then  s0[j]:='7'
    else  if  s0[j]='D' then  s0[j]:='H'
    else  if  s0[j]='E' then  s0[j]:='1'
    else  if  s0[j]='F' then  s0[j]:='L'
    else  if  s0[j]='G' then  s0[j]:='A'
    else  if  s0[j]='H' then  s0[j]:='3'
    else  if  s0[j]='I' then  s0[j]:='G'
    else  if  s0[j]='J' then  s0[j]:='V'
    else  if  s0[j]='K' then  s0[j]:='K'
    else  if  s0[j]='L' then  s0[j]:='W'
    else  if  s0[j]='M' then  s0[j]:='6'
    else  if  s0[j]='N' then  s0[j]:='F'
    else  if  s0[j]='O' then  s0[j]:='X'
    else  if  s0[j]='P' then  s0[j]:='B'
    else  if  s0[j]='Q' then  s0[j]:='Y'
    else  if  s0[j]='R' then  s0[j]:='4'
    else  if  s0[j]='S' then  s0[j]:='Z'
    else  if  s0[j]='T' then  s0[j]:='5'
    else  if  s0[j]='U' then  s0[j]:='Q'
    else  if  s0[j]='V' then  s0[j]:='D'
    else  if  s0[j]='W' then  s0[j]:='0'
    else  if  s0[j]='X' then  s0[j]:='C'
    else  if  s0[j]='Y' then  s0[j]:='P' 
    else  if  s0[j]='Z' then  s0[j]:='E' ;
    //   str_Auto1:=str_Auto1+S0[j];
     end;


    // str_Auto1:=S0[3]+S0[5]+S0[2]+S0[1]+S0[4];

       str_Auto1:=s0;
     result:=str_Auto1;
  end;


function DenCrypt0(s1: String): String;
     var m,j:integer;
        str_re:string;
  begin



     m:=length(s1);
     for j:=1 to m do
     begin


      if  s1[j]='8'then s1[j]:='0'
    else  if  s1[j]='I' then s1[j]:='1'
    else  if  s1[j]='R' then s1[j]:='2'
    else  if  s1[j]='9' then s1[j]:='3'
    else  if  s1[j]='S' then  s1[j]:='4'
    else  if  s1[j]='N' then  s1[j]:='5'
    else  if  s1[j]='O' then  s1[j]:='6'
    else  if  s1[j]='T' then  s1[j]:='7'
    else  if  s1[j]='J' then  s1[j]:='8'
    else  if  s1[j]='2' then  s1[j]:='9'
    else  if  s1[j]='M' then  s1[j]:='A'
    else  if  s1[j]='U' then  s1[j]:='B'
    else  if  s1[j]='7' then  s1[j]:='C'
    else  if  s1[j]='H' then  s1[j]:='D'
    else  if  s1[j]='1' then  s1[j]:='E'
    else  if  s1[j]='L' then  s1[j]:='F'
    else  if  s1[j]='A' then  s1[j]:='G'
    else  if  s1[j]='3' then  s1[j]:='H'
    else  if  s1[j]='G' then  s1[j]:='I'
    else  if  s1[j]='V' then  s1[j]:='J'
    else  if  s1[j]='K' then  s1[j]:='K'
    else  if  s1[j]='W' then  s1[j]:='L'
    else  if  s1[j]='6' then  s1[j]:='M'
    else  if  s1[j]='F' then  s1[j]:='N'
    else  if  s1[j]='X' then  s1[j]:='O'
    else  if  s1[j]='B' then  s1[j]:='P'
    else  if  s1[j]='Y' then  s1[j]:='Q'
    else  if  s1[j]='4' then  s1[j]:='R'
    else  if  s1[j]='Z' then  s1[j]:='S'
    else  if  s1[j]='5' then  s1[j]:='T'
    else  if  s1[j]='Q' then  s1[j]:='U'
    else  if  s1[j]='D' then  s1[j]:='V'
    else  if  s1[j]='0' then  s1[j]:='W'
    else  if  s1[j]='C' then  s1[j]:='X'
    else  if  s1[j]='P' then  s1[j]:='Y'
    else  if  s1[j]='E' then  s1[j]:='Z' ;

     end;


       //    str_re:=S1[4]+S1[3]+S1[1]+S1[5]+S1[2];
       str_re:=S1;
     result:= str_re;
  end;


//-----------------------------------------------------------------------------------

  end.