myfun.pas

自动升级的程序,支持断点下载,稍微修改一下就可以适用了任何文件的升级

unit MyFun;

interface

  uses
    Forms, windows,SysUtils,IniFiles,Dialogs,DateUtils,Registry,Nb30,WinSock;

const
	ID_BIT	=	$200000;    
type
	TCPUID	= array[1..4] of Longint;
	TVendor	= array [0..11] of char;
  TCPUMSG = record
    ID1    : String;
    ID2    : String;
    ID3    : String;
    ID4    : String;
    PValue : String;
    FValue : String;
    MValue : String;
    SValue : String;
    Vendor : String;
   end;


function  Decry(Str: String): String;
function  Encry(Str: String): String;
function  StrEncode(const Str: String): String;
function  HexToInt(Str: String): Int64;
function  StrDecode(const Str: String): String;

function IsCPUID_Available : Boolean; register;
function GetCPUID : TCPUID; assembler; register;
function GetCPUVendor : TVendor; assembler; register;
function GetCPUMSG:TCPUMSG;
procedure ReadReg;
function GetExeSize(ExeSize:integer):Boolean;

function GetIdeDiskSerialNumber(var SerialNumber: string; var ModelNumber: string;
 var FirmwareRev: string; var TotalAddressableSectors: ULong;
 var SectorCapacity: ULong; var SectorsPerTrack: Word): Boolean; //得到硬盘物理号
function GetMacAddr(a: integer):String;

procedure AdjustToken;
function GetPCName:string;
function GetIP:String;


implementation

uses Main;

//一般字串转十六进位字串符号 , 如 '测试' 转成 'B4FAB8D5'
function Decry(Str: String): String;
var
  i: integer;
begin
  result := '';
  for i := 1 to Length(Str) do
      result := result + IntToHex( Ord( Str[i] ), 2 );
end;

//十六进位字串符号转回一般字串 , 如 'B4FAB8D5' 转成 '测试'
function Encry(Str: String): String;
var
  i: integer;
begin
  result := '';
  for i := 1 to Length(Str) do
    begin
      if ((i mod 2) = 1) then  result := result + chr( StrToInt( '0x' + Copy( Str, i, 2 )));
    end;
end;


//十六进位值字串转成整数
function HexToInt(Str: String): Int64;
var
  RetVar : Int64;
  i : byte;
begin
  if (Str='') then
     begin
       result := 0;
       exit;
     end;
  Str := UpperCase(Str);
  if Str[length(Str)] = 'H' then  Delete(Str,length(Str),1);
  RetVar := 0;
  for i := 1 to length(Str) do
    begin
      RetVar := RetVar shl 4;
      if Str[i] in ['0'..'9'] then  RetVar := RetVar + (byte(Str[i]) - 48)
      else if Str[i] in ['A'..'F'] then RetVar := RetVar + (byte(Str[i]) - 55)
      else
        begin
          Retvar := 0;
          break;
        end;
    end;
  result := RetVar;
end;

//将字串进行 URL 编码
function StrEncode(const Str: String): String;
var
  I: Integer;
begin
  result := '';
  if Length(Str) > 0 then
    for I := 1 to Length(Str) do
      begin
        if not (Str[I] in ['0'..'9', 'a'..'z','A'..'Z', ' ']) then result := result + '%' + IntToHex(Ord(Str[I]), 2)
        else if not (Str[I] = ' ') then result := result + Str[I]
        else  result := result + '%20';
      end;
end;


//将 URL 字串进行解码
function StrDecode(const Str: String): String;
var
  I: Integer;
begin
  result := '';
  if Length(Str) > 0 then
    begin
      I := 1;
      while I <= Length(Str) do
        begin
          if Str[I] = '%' then
            begin
              result := result + Chr(HexToInt(Str[I+1] + Str[I+2]));
              I := Succ(Succ(I));
            end
          else if Str[I] = '+' then  result := result + ' '
          else  result := result + Str[I];
          I := Succ(I);
        end;
    end;
end;

function IsCPUID_Available : Boolean; register;
asm
	PUSHFD							{direct access to flags no possible, only via stack}
  POP     EAX					{flags to EAX}
  MOV     EDX,EAX			{save current flags}
  XOR     EAX,ID_BIT	{not ID bit}
  PUSH    EAX					{onto stack}
  POPFD								{from stack to flags, with not ID bit}
  PUSHFD							{back to stack}
  POP     EAX					{get back to EAX}
  XOR     EAX,EDX			{check if ID bit affected}
  JZ      @exit				{no, CPUID not availavle}
  MOV     AL,True			{Result=True}
@exit:
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 GetCPUMSG:TCPUMSG;
var
  CPUID : TCPUID;
  I     : Integer;
  S			: String;//TVendor;
  cups:TCPUMSG ;
begin
	for I := Low(CPUID) to High(CPUID)  do CPUID[I] := -1;
  if IsCPUID_Available then
    begin
      CPUID	:= GetCPUID;
      cups.ID1   := pchar(IntToHex(CPUID[1],8));
      cups.ID2   := pchar(IntToHex(CPUID[2],8));
      cups.ID3   := pchar(IntToHex(CPUID[3],8));
      cups.ID4   := pchar(IntToHex(CPUID[4],8));
      cups.PValue:= pchar(IntToStr(CPUID[1] shr 12 and 3));
      cups.FValue:= pchar(IntToStr(CPUID[1] shr 8 and $f));
      cups.MValue:= pchar(IntToStr(CPUID[1] shr 4 and $f));
      cups.SValue:= pchar(IntToStr(CPUID[1] and $f));
      S := GetCPUVendor;
      cups.Vendor:= PChar(S);
    end
  else
    begin
      cups.Vendor := 'CPUID not available';
    end;
  result :=cups;
end;

function GetIdeDiskSerialNumber(var SerialNumber: string; var ModelNumber: string;
 var FirmwareRev: string; var TotalAddressableSectors: ULong;
 var SectorCapacity: ULong; var SectorsPerTrack: Word): Boolean; //得到硬盘物理号
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;