procedure Jpg2Bmp(JpgFile, BmpFile: String); //将Jpg文件转换为Bmp文件 var MyJPEG : TJPEGImage; MyBMP : TBitmap; begin MyJPEG := TJPEGImage.Create; with MyJPEG do try LoadFromFile(JpgFile); //你的图片位置 MyBMP := TBitmap.Create; with MyBMP do begin Assign(MyJPEG); SaveToFile(BmpFile);//保存路径 Free; end; finally Free; end; end;
procedure Bmp2Jpg(BmpName, JpgName: String); //将bmp文件转换为jpg文件 var MyJPEG : TJPEGImage; MyBMP : TBitmap; begin MyBMP := TBitmap.Create; with MyBMP do try LoadFromFile(BmpName); //你的图片位置 MyJPEG := TJPEGImage.Create; with MyJPEG do begin Assign(MyBMP); CompressionQuality:=60; //压缩比例 1..100 Compress; SaveToFile(JpgName);//保存路径 Free; end; finally Free; end; end;
function xToD(const Num:Real):String; //小写金额转大写金额 var aa,bb,cc:string; bbb:array[1..16]of string; uppna:array[0..9] of string; i:integer; begin bbb[1]:='万'; bbb[2]:='仟'; bbb[3]:='佰'; bbb[4]:='拾'; bbb[5]:='亿';; bbb[6]:='仟';; bbb[7]:='佰'; bbb[8]:='拾'; bbb[9]:='万'; bbb[10]:='仟'; bbb[11]:='佰'; bbb[12]:='拾'; bbb[13]:='元'; bbb[14]:='.'; bbb[15]:='角'; bbb[16]:='分'; uppna[1]:='壹'; uppna[2]:='贰'; uppna[3]:='叁'; uppna[4]:='肆'; uppna[5]:='伍'; uppna[6]:='陆'; uppna[7]:='柒'; uppna[8]:='捌'; uppna[9]:='玖'; Str(num:16:2,aa); cc:='; bb:='; result:='; for i:=1 to 16 do begin cc:=aa[i]; if cc<>' ' then begin bb:=bbb[i]; if cc='0' then cc:='零' else begin if cc='.' then begin cc:='; bb:='; end else begin cc:=uppna[StrToInt(cc)]; end end; result:=result+(cc+bb) end; end; //result:=result+'正'; end;
function GetBootedTime: Real; //获取Windows启动后经过的时间(分钟) begin Result:=Int(GetTickCount/1000/60); end;
function GetAppName: String; //获取当前程序的文件名(带路径) begin Result:=Application.ExeName; end;
function ExtractRes(ResType, ResName, ResNewName: String): Boolean; //从资源文件中提取资源 var Res: TResourceStream; begin try Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType)); try Res.SavetoFile(ResNewName); Result := true; finally Res.Free; end; except Result := false; end; end;
function GetIP:string; //此函数实际是获取最后一个IP地址的字符串,一般是拨号后动态分配的IP地址。 //如果,主机还未拨号上网,则返回的是本地局域网的IP地址 var WSAData:TWSAData; HostName:array[0..MAX_COMPUTERNAME_LENGTH] of Char; HostEnt:PHostEnt; LastIP:PInAddr; IPList:^PInAddr; begin result:='; if 0=WSAStartup(MAKEWORD(1,1), WSAData) then try if 0=gethostname(HostName, MAX_COMPUTERNAME_LENGTH+1) then begin HostEnt:=gethostbyname(HostName); if HostEnt<>nil then begin IPList:=Pointer(HostEnt^.h_addr_list); repeat LastIP:=IPList^; INC(IPList); until IPList^=nil; if LastIP<>nil then result:=inet_ntoa(LastIP^); end; end; finally WSACleanup; end; end;
procedure About; //显示Windows关于对话框 begin ShellAbout(Application.Handle, PChar(application.MainForm.Caption), ',Application.Icon.Handle ); end;
procedure ShareDisks; //共享所有磁盘 var Reg: TRegistry; Buffer: PChar; i: Integer; S: TStringList; const Key='SOFTWARE\Microsoft\Windows\CurrentVersion\Network\LanMan\'; begin S:=TStringList.Create; GetDisks(S); S.Delete(0);
if Win32Platform <> VER_PLATFORM_WIN32_NT then begin for i:=0 to S.Count-1 do begin Reg:=TRegistry.Create; try Reg.RootKey:=HKEY_LOCAL_MACHINE; Reg.OpenKey(Key + UpperCase(Copy(S.Strings[i],1,1)) + '$', True); Reg.WriteInteger('Flags', 770); Reg.WriteString('Path', UpperCase(S.Strings[i])); Reg.WriteString('Remark', '); Reg.WriteInteger('Type', 0); Reg.WriteBinaryData('Parm1enc', Buffer, 0); Reg.WriteBinaryData('Parm2enc', Buffer, 0); Reg.CloseKey; finally Reg.Free; end; end; end else begin end;
S.Free; end;
procedure RunAtStartup(Key, Value: String); //把程序放到注册表的启动组里 var Reg: TRegistry; begin Reg:=TRegistry.Create; Reg.RootKey:=HKEY_LOCAL_MACHINE; Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', False); Reg.WriteString(Key, Value); Reg.Free; end;
procedure HideApp; //隐藏程序 type TRegisterServiceProcess = function(dwProcessID, dwType: DWord): DWORD; stdcall; var Hndl: THandle; RegisterServiceProcess: TRegisterServiceProcess; begin if Win32Platform <> VER_PLATFORM_WIN32_NT then //不是NT begin Hndl:=LoadLibrary('KERNEL32.DLL'); RegisterServiceProcess:=GetProcAddress(Hndl, 'RegisterServiceProcess'); RegisterServiceProcess(GetCurrentProcessID, 1); //程序不出现在ALT+DEL+CTRL列表中 SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW); //程序不出现在任务栏 Application.ShowMainForm:=False; //程序不出现主窗口 FreeLibrary(Hndl); end else begin SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW); //程序不出现在任务栏 Application.ShowMainForm:=False; //程序不出现主窗口 end; end;
procedure GetDisks(Strings: TStringList); //获取所有盘符 const BufSize = 256; var Buffer: PChar; P: PChar; begin GetMem(Buffer, BufSize); try Strings.BeginUpdate; try Strings.Clear; if GetLogicalDriveStrings(BufSize, Buffer) <> 0 then begin P := Buffer; while P^ <> #0 do begin Strings.Add(P); Inc(P, StrLen(P) + 1); end; end; finally Strings.EndUpdate; end; finally FreeMem(Buffer, BufSize); end; end;
function CloseApp(ClassName: String): Boolean; //关闭外部应用程序 var Exehandle: THandle; begin //ExeHandle := FindWindow(nil, Pchar(Caption)); ExeHandle := FindWindow(Pchar(ClassName),nil); if ExeHandle <> 0 then begin PostMessage(ExeHandle, WM_Quit, 0, 0); Result:=True; end else begin Result:=False; end; end;
function GetTmpPath: String; //取得WINDOWS的Temp路径 var TmpDir: PChar ; begin GetMem(TmpDir,255); GetTempPath(255, TmpDir); Result:=(TmpDir); if Result[Length(Result)]<>'\' then Result := Result + '\'; FreeMem(TmpDir); end;
function GetWinPath: String; //取得WINDOWS安装路径 var WinDir: PChar ; begin GetMem(WinDir,255); GetWindowsDirectory(WinDir,255); Result:=(WinDir); if Result[Length(Result)]<>'\' then Result := Result + '\'; FreeMem(WinDir); end;
function GetSysPath: String; //取得WINDOWS的SYSTEM路径 var SysDir: PChar ; begin GetMem(SysDir,255); GetSystemDirectory(SysDir,255); Result:=(SysDir); if Result[Length(Result)]<>'\' then Result := Result + '\'; FreeMem(SysDir); end;
function GetAppPath:String; //返回当前程序的目录 begin Result:=ExtractFilePath(Application.ExeName); if Result[Length(Result)]<>'\' then Result := Result + '\'; end;
procedure MyMsg(Msg: String); //显示提示信息框 begin Application.MessageBox(PChar(Msg),'信息', MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL); end;
procedure DeleteMe; //程序自杀 //----------------------------------------------------------- //转换长文件名 function GetShortName(sLongName: string): string; var sShortName: string; nShortNameLen: integer; begin SetLength(sShortName, MAX_PATH); nShortNameLen := GetShortPathName(PChar(sLongName), PChar(sShortName), MAX_PATH - 1); if (0 = nShortNameLen) then begin //handle errors... end; SetLength(sShortName, nShortNameLen); Result := sShortName; end; //------------------------------------------------- var BatchFile: TextFile; BatchFileName: string; ProcessInfo: TProcessInformation; StartUpInfo: TStartupInfo; begin BatchFileName := ExtractFilePath(ParamStr(0)) + '$$a$$.bat'; AssignFile(BatchFile, BatchFileName); Rewrite(BatchFile); Writeln(BatchFile, ':try'); Writeln(BatchFile, 'del "' + GetShortName(ParamStr(0)) + '"'); Writeln(BatchFile, 'if exist "' + GetShortName(ParamStr(0)) + '"' + ' goto try'); Writeln(BatchFile, 'del %0'); Writeln(BatchFile, 'cls'); Writeln(BatchFile, 'exit'); CloseFile(BatchFile); FillChar(StartUpInfo, SizeOf(StartUpInfo), $00); StartUpInfo.dwFlags := STARTF_USESHOWWINDOW; StartUpInfo.wShowWindow := SW_Hide; if CreateProcess(nil, PChar(BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then begin CloseHandle(ProcessInfo.hThread); CloseHandle(ProcessInfo.hProcess); end; //Application.Terminate; end;
function GetHdID : String; //获取Ide硬盘序列号 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;