global.pas

自己做的用delphi开发的学生成绩管理系统。

function GetGUID:string;//获取一个唯一标识
var id:tguid;
    s:string;
begin
 if CoCreateGuid(id)=s_ok then
  s:=guidtostring(id);
  delete(s,1,1);
  delete(s,length(s),1);
  while pos('-',s)>0 do
    delete(s,pos('-',s),1);
  result:=s;
end;

procedure GetStructStr(Str,Seperator,pResult:pchar;index:integer);//获取用分隔符分隔的字符串索引为index的字符串
var s,sep,left:string;
    i,ipos:integer;
begin
  if not assigned(pResult) then
    exit;
  s:=str;
  sep:=Seperator;
  i:=0;
  while i<index do
  begin
    ipos:=pos(sep,s);
    if ipos<1 then
      break;
    left:=leftstr(s,ipos-1);
    s:=rightstr(s,length(s)-ipos);
    inc(i);
  end;
  if i>=index then
    strplcopy(pResult,left,length(left))
  else
    strplcopy(pResult,s,length(s));
end;

function GetSepCount(Str,Seperator:pchar):integer;stdcall;//取字符串中子串Seperator的个数。
var s,sep:string;
begin
  s:=str;
  sep:=Seperator;
  result:=0;
  while pos(sep,s)>0 do
  begin
    s:=rightstr(s,length(s)-pos(sep,s));
    inc(result);
  end;
end;



procedure GetNetCardAddress(pResult:pchar;len:integer);//获取网卡地址
type
  ASTAT =record
      adapt:TADAPTERSTATUS;
      NameBuff:array[0..30] of TNameBuffer;
  end;
var
  ncb:^TNCB;
  AdapterList:^TLanaEnum;
  ret:Char;
  i,K:integer;
  Adapter:^ASTAT;
  textt:string;
  pAdd:string;
  m_byteAddressMySelf:string;
  sTemp:string;
begin
    if not assigned(pResult) then
      exit;
    getMem(ncb,sizeof(TNCB));
    getMem(AdapterList,sizeof(TLanaEnum));
    fillchar(ncb^,sizeof(ncb^),0);
    fillchar(AdapterList^,sizeof(AdapterList),0);
    ncb^.ncb_command:=char(NCBENUM);
    Ncb^.ncb_buffer := pchar(AdapterList);
    Ncb^.ncb_length := sizeof(AdapterList);
    Netbios(PNCB(ncb));
    if (Ncb^.ncb_retcode<>char(NRC_GOODRET)) then
    begin
        freemem(Ncb);
        freemem(AdapterList);
        exit;
    end;
    For I:=0 to ord(AdapterList^.Length)-1 do
    begin
      fillchar(ncb^,sizeof(ncb^),0);
      Ncb^.ncb_command := char(NCBRESET);
      Ncb^.ncb_lana_num := AdapterList.lana[i];
      if (Netbios(PNCB(Ncb)) <> char(NRC_GOODRET)) then
      begin
        freemem(ncb);
        freemem(AdapterList);
        exit;
      end;
      fillchar(ncb^,sizeof(ncb^),0);
      Ncb^.ncb_command := char(NCBASTAT);
      Ncb^.ncb_lana_num := AdapterList.lana[i];
      ncb^.ncb_callname:='*';

      getMem(Adapter,sizeof(Adapter^));
      fillchar(Adapter^,sizeof(Adapter^),0);
      Ncb^.ncb_buffer := pchar(Adapter);
      Ncb^.ncb_length := sizeof(Adapter^);

      ret:=Netbios(PNCB(Ncb));
      //freemem(Ncb);
      if (ret=#0) then
      begin
        for K:=0 to 5 do
          pAdd:=Adapter^.adapt.adapter_address[k];
          if(Adapter^.adapt.adapter_address[K]<>#0)then
          begin
            textt:=format('%.02X %.02X %.02X %.02X %.02X %.02X',
                 [ord(Adapter^.adapt.adapter_address[0]),
            ord(Adapter^.adapt.adapter_address[1]),
            ord(Adapter^.adapt.adapter_address[2]),
            ord(Adapter^.adapt.adapter_address[3]),
            ord(Adapter^.adapt.adapter_address[4]),
            ord(Adapter^.adapt.adapter_address[5])]);
            stemp:=textt;
            strplcopy(pResult,stemp,len-1);
            pResult[len-1]:=#0;
            break;
          end;
       end;
       freemem(Adapter);
    end;
    freeMem(NCB);
    freemem(AdapterList);
end;

procedure GetDiskId(pResult:pchar;len:integer);//获取硬盘型号标识与硬盘ID
type
    mychar32=array[0..31] of char;
    TDiskId32=Function(var DiskModel,DiskID:mychar32):BOOL;stdcall;
var
    f1:TDiskId32;
    model,id:mychar32;
    h:Thandle;
    chDir:array[0..254] of char;
    dllName,s:string;
    sResult:string;
begin
  if not assigned(presult) then
    exit;
  sResult:='';
  s:=getcurrentdir;
  if rightstr(s,1)<>'\' then
    s:=s+'\';
  dllName:=s+'DiskInfo.dll';
  if not fileexists(dllName) then
  begin
    getwindowsdirectory(@chDir,sizeof(chDir));
    s:=chDir;
    dllName:=s+'\DiskInfo.dll';
    if not fileexists(dllName) then
    begin
      getsystemdirectory(@chDir,sizeof(chDir));
      s:=chDir;
      dllName:=s+'\DiskInfo.dll';
    end;
  end
  else
  begin
    getsystemdirectory(@chDir,sizeof(chDir));
    s:=chDir;
    copyfile(pchar(dllName),pchar(s+'\DiskInfo.dll'),true);
  end;
  h:=Loadlibrary(pchar(dllName));
  if h>0 then
  begin
    f1:=nil;
    @f1:=GetProcAddress(h,pchar('DiskID32'));
    if assigned(f1) then
    begin
      f1(model,id);
      sResult:=id;
      strplcopy(presult,sresult,len-1);
      presult[len-1]:=#0;
    end;
    freelibrary(h);
  end;
end;

function GetIdeDiskId : String;//获取硬盘ID
  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;




end.