myfun.pas

升级程序升级程序升级程序升级程序升级程序升级程序升级程序升级程序

 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 := False;
  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(SerialNumber, sSerialNumber, sizeof(sSerialNumber)); //硬盘生产序号

     ChangeByteOrder(sModelNumber, sizeof(sModelNumber));
     SetString(ModelNumber, sModelNumber, sizeof(sModelNumber)); //硬盘型号

     ChangeByteOrder(sFirmwareRev, sizeof(sFirmwareRev));
     SetString(FirmwareRev, sFirmwareRev, sizeof(sFirmwareRev)); //硬盘硬件版本
     Result := True;
     ChangeByteOrder(ulTotalAddressableSectors, sizeof(ulTotalAddressableSectors));
     TotalAddressableSectors := ulTotalAddressableSectors; //硬盘ulTotalAddressableSectors叁数

     ChangeByteOrder(ulCurrentSectorCapacity, sizeof(ulCurrentSectorCapacity));
     SectorCapacity := ulCurrentSectorCapacity; //硬盘wBytesPerSector叁数

     ChangeByteOrder(wNumCurrentSectorsPerTrack, sizeof(wNumCurrentSectorsPerTrack));
     SectorsPerTrack := wNumCurrentSectorsPerTrack; //硬盘wSectorsPerTrack叁数
   end;
end;

function GetMacAddr(a: integer):String;
Var
  NCB:TNCB;
  ADAPTER : TADAPTERSTATUS;
  LANAENUM : TLANAENUM;
  intIdx : Integer;
  cRC : Char;
  MacAddr : String;
Begin
  Result := '';// Initialize
  Try
    // Zero control blocl
    ZeroMemory(@NCB, SizeOf(NCB));
    // Issue enum command
    NCB.ncb_command:=Chr(NCBENUM);
    cRC := NetBios(@NCB);
    // Reissue enum command
    NCB.ncb_buffer := @LANAENUM;
    NCB.ncb_length := SizeOf(LANAENUM);
    cRC := NetBios(@NCB);
    If Ord(cRC)<>0 Then  exit;
    // Reset adapter
    ZeroMemory(@NCB, SizeOf(NCB));
    NCB.ncb_command := Chr(NCBRESET);
    NCB.ncb_lana_num := LANAENUM.lana[a];
    cRC := NetBios(@NCB);
    If Ord(cRC)<>0 Then exit;
    // Get adapter address
    ZeroMemory(@NCB, SizeOf(NCB));
    NCB.ncb_command := Chr(NCBASTAT);
    NCB.ncb_lana_num := LANAENUM.lana[a];
    StrPCopy(NCB.ncb_callname, '*');
    NCB.ncb_buffer := @ADAPTER;
    NCB.ncb_length := SizeOf(ADAPTER);
    cRC := NetBios(@NCB);
    // Convert it to string
    MacAddr := '';
    For intIdx := 0 To 5 Do
      MacAddr := MacAddr + InttoHex(Integer(ADAPTER.adapter_address[intIdx]),2);
    result:=(MacAddr);
  Finally
  End;
end;

procedure ReadReg;
var
  DT,USEDT,RegDT,DDT,TempDT:String;
  Code,ID:String;
  ECode,EID:String;  
  EDT:TDateTime;  
  Y,M,D:Word;//加密中所用的月日(之所以拆开是为了兼容各个语言平台下时间格式的不一致)
  Pos:integer; //查询'-'在时间中所处的位置
  LocaleName: array[0..4] of Char;
begin
//  GetLocaleInfo(SysLocale.DefaultLCID,LOCALE_SABBREVLANGNAME,LocaleName,SizeOf(LocaleName));
//  DecodeDate(Date,Y,M,D);
//  DT:=IntToStr(Y)+'-'+IntToStr(M)+'-'+IntToStr(D);
//  DDT:=Decry(DT);
//  MyReg.OpenKey('SOFTWARE\Classes\Interface\{00000021-0000-0010-8000-00AA006D2EA4}\TypeLib',True);
{  ID:=MyReg.ReadString('CLSID');
  if ID<>'' then EID:=Encry(ID);
  CODE:=MyReg.ReadString('LIBID');
  if Code<>'' then ECode:=Encry(Code);
  AA:=ECode;
  BB:=Decry(EID+'@'+'vagrant');
  if  ((ID='')or(Code='')) or (ECode<>Decry(EID+'@'+'vagrant'))then
    begin
      IsReg:=False;
      MyReg.CloseKey;
      //读取天数
      }
//      MyReg.OpenKey('SOFTWARE\Classes\Interface\{00000023-0000-0010-8000-00AA006D2EA4}\TypeLib',True);
{
      RegDT:=MyReg.ReadString('GUID');
      if RegDT='' then  MyReg.WriteString('GUID',DDT)
      else
        begin
          try
            TempDT:=Encry(RegDT);
            //一一取出年月日
            Pos:=System.Pos('-',TempDT);
            Y:=StrToInt(copy(TempDT,0,Pos-1));
            TempDT:=Copy(TempDT,Pos+1,Length(TempDT));
            Pos:=System.Pos('-',TempDT);
            M:=StrToInt(copy(TempDT,0,Pos-1));
             //最後一次就是日了，不需要再进行Pos('-',Str)操作了
            TempDT:=Copy(TempDT,Pos+1,Length(TempDT));
            D:=StrToInt(TempDT);
            EDT:=EncodeDate(Y,M,D);
            if DaysBetween(EDT,Date)>=1800 then
              begin
                if System.Pos('CHT',UpperCase(LocaleName))>0  Then   Application.MessageBox('软件是试用版，已过试用期请注册，谢谢！','错误提示',MB_OK+MB_ICONERROR)
                else if System.Pos('CHS',UpperCase(LocaleName))>0 then  Application.MessageBox('  璃      唳ㄛ  彻          聊ㄛ郅郅ㄐ','渣      ',MB_OK+MB_ICONERROR)
                Else Application.MessageBox('This Software is Demo,Please Buy!','Error',MB_OK+MB_ICONERROR);
                IsOver:=True;
              end
            else if DaysBetween(EDT,Date)>=3655 then
              begin
                if System.Pos('CHT',UpperCase(LocaleName))>0 Then   Application.MessageBox(PChar('软件是60天试用版，还剩下'+IntToStr(60-DaysBetween(EDT,Date))+'天到期！请购买正式版，谢谢！'),'错误提示',MB_OK+MB_ICONERROR)
                else if System.Pos('CHS',UpperCase(LocaleName))>0 then  Application.MessageBox(PChar('  璃  60      唳ㄛ逊    '+IntToStr(60-DaysBetween(EDT,Date))+'  善  ㄐ  划枪    唳ㄛ郅郅ㄐ'),'渣      ',MB_OK+MB_ICONERROR)
                Else Application.MessageBox('This Software is Demo,Please Buy!','Error',MB_OK+MB_ICONERROR);
              end;
          except
            on E:Exception do
              begin
                if System.Pos('CHT',UpperCase(LocaleName))>0 Then   Application.MessageBox(PChar('软件是试用版，已过试用期请注册，谢谢！'),'错误提示',MB_OK+MB_ICONERROR)
                else if System.Pos('CHS',UpperCase(LocaleName))>0 then  Application.MessageBox(PChar('  璃      唳ㄛ  彻          聊ㄛ郅郅ㄐ'),'渣      ',MB_OK+MB_ICONERROR)
                Else Application.MessageBox('This Software is Demo,Please Buy!','Error',MB_OK+MB_ICONERROR);
                IsOver:=True;
              end;
          end;
        end;
    end
  else
    begin
      IsReg:=True;
      IsOver:=False;
    end;
  MyReg.CloseKey;
  }
end;


function GetExeSize(ExeSize:integer):Boolean;
var
  Sr: TSearchRec;
  size : Longint;
begin
  Result:=False;
  FindFirst(ParamStr(0),$27,Sr);
  size:=Sr.Size;
  FindClose(Sr);
  if (size/1024)>ExeSize then Result:=False
  else Result:=True;
end;

procedure AdjustToken;
var
  hdlProcessHandle : Cardinal;
  hdlTokenHandle   : Cardinal;
  tmpLuid          : Int64;
  tkp              : TOKEN_PRIVILEGES;
  tkpNewButIgnored : TOKEN_PRIVILEGES;
  lBufferNeeded    : Cardinal;
  Privilege        : array[0..0] of _LUID_AND_ATTRIBUTES;
begin
  hdlProcessHandle := GetCurrentProcess;
  OpenProcessToken(hdlProcessHandle,(TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY),hdlTokenHandle);
  // Get the LUID for shutdown privilege.
  LookupPrivilegevalue('', 'SeShutdownPrivilege', tmpLuid);
  Privilege[0].Luid := tmpLuid;
  Privilege[0].Attributes := SE_PRIVILEGE_ENABLED;
  tkp.PrivilegeCount := 1;   // One privilege to set
  tkp.Privileges[0] := Privilege[0];
  // Enable the shutdown privilege in the access token of this process.
  AdjustTokenPrivileges(hdlTokenHandle,False,tkp,Sizeof(tkpNewButIgnored),tkpNewButIgnored,lBufferNeeded);
end;

function GetPCName : String ;
var
  LocalMachine: PChar;
  Len: DWord;
begin
  Len := MAX_COMPUTERNAME_LENGTH + 1; // 取得本机电脑名称
  GetMem(LocalMachine,Len);
  if GetComputerName(LocalMachine,Len) then Result := LocalMachine
  else  Result := 'UnKnow';
  FreeMem(LocalMachine,Len);
end;

function GetIP:String;
var
  phe:pHostEnt;
  w:TWSAData;
  ip_address:longint;
  p:^longint;
  ipstr:string;
begin
  if WSAStartup(2,w)<>0 then exit;
  phe:=GetHostbyName(pchar(GetPCName));
  if phe<>nil then
    begin
      p:=pointer(phe^.h_addr_list^);
      ip_address:=p^;
      ip_address:=ntohl(ip_address);
      ipstr:=IntToStr(ip_address shr 24)+'.'+IntToStr((ip_address shr 16) and $ff)
         +'.'+IntToStr((ip_address shr 8) and $ff)+'.'+IntToStr(ip_address and $ff);
      Result :=ipstr;
    end;
end;
end.