📄 tools.pas
字号:
unit tools;
interface
uses windows,Forms,mmsystem,winsock,sysutils,classes,controls,messages,activex,
shlobj,menus,comobj,jpeg,graphics,extctrls,ShellApi,contnrs,dialogs;
const
SHFMT_ID_DEFAULT = $FFFF; // Formating options
SHFMT_OPT_QUICKFORMAT = $0000; // Quick format
SHFMT_OPT_FULL = $0001; // Full format
SHFMT_OPT_SYSONLY = $0002; // Translate system file
SHFMT_ERROR = $FFFFFFFF; // Error codes
SHFMT_CANCEL = $FFFFFFFE;
SHFMT_NOFORMAT = $FFFFFFFD;
const
FREQ_SCALE=$1193180;
RSP_HIDE=1;
RSP_SHOW=0;
const
MAX_PROTOCOL_CHAIN=7;
WSAPROTOCOL_LEN=255;
type WSAPROTOCOLCHAIN =record
ChainLen:integer;
ChainEntries:array[0..MAX_PROTOCOL_CHAIN] of dword;
end;
type
WSAPROTOCOL_INFOW =record
dwServiceFlags1:dword;
dwServiceFlags2:dword;
dwServiceFlags3:dword;
dwServiceFlags4:dword;
dwProviderFlags:dword;
ProviderId:TGUID;
dwCatalogEntryId:dword;
ProtocolChain:WSAPROTOCOLCHAIN;
iVersion:integer;
iAddressFamily:integer;
iMaxSockAddr:integer;
iMinSockAddr:integer;
iSocketType:integer;
iProtocol:integer;
iProtocolMaxOffset:integer;
iNetworkByteOrder:integer;
iSecurityScheme:integer;
dwMessageSize:dword;
dwProviderReserved:dword;
szProtocol:array[0..WSAPROTOCOL_LEN+1] of char;
end;
type
PPASSWORD_CACHE_ENTRY=^TPASSWORD_CACHE_ENTRY;
TPASSWORD_CACHE_ENTRY=packed record
cbEntry: word; //password entry的字节长度
cbResource: word; //resource name的字节长度
cbPassword: word; //password的字节长度
iEntry: byte; //entry index
nType: byte; //type of entry
abResource : array[0..200] of char; //start of resource name
//password immediately follows resource name
end;
const
CCH_MAXNAME=255;
LNK_RUN_MIN=7;
LNK_RUN_MAX=3;
LNK_RUN_NORMAL=1;
type LINK_FILE_INFO=record ///快捷方式文件信息数据结构
FileName:array[0..MAX_PATH] of char; ///目标文件名
WorkDirectory:array[0..MAX_PATH] of char; ///工作目录
IconLocation:array[0..MAX_PATH] of char; ///图标文件
IconIndex:integer; ///图标索引
Arguments:array[0..MAX_PATH] of char; ///运行参数
Description:array[0..CCH_MAXNAME] of char; ///文件描述
ItemIDList:PItemIDList; ///系统IDList，未使用
RelativePath:array[0..255] of char;///相对路径
ShowState:integer; ///运行时的现实状态
HotKey:word; ///热键
end;
const
FILE_CREATE_TIME=0; ///文件建立时间
FILE_MODIFY_TIME=1; ///修改时间
FILE_ACCESS_TIME=2; ///最后访问时间，不过好像总是当前时间？
const
RAS_MaxDeviceType = 16;//设备类型名称长度
RAS_MaxEntryName = 256;//连接名称最大长度
RAS_MaxDeviceName = 128;//设备名称最大长度
RAS_MaxIpAddress = 15;//IP地址的最大长度
RASP_PppIp = $8021;//拨号连接的协议类型，该数值表示PPP连接
type
HRASCONN = DWORD;//拨号连接句柄的类型
RASCONN = record//活动的拨号连接的句柄和设置信息
dwSize : DWORD;//该结构所占内存的大小(Bytes),一般设置为SizeOf(RASCONN)
hrasconn : HRASCONN;//活动连接的句柄
szEntryName : array[0..RAS_MaxEntryName] of char;//活动连接的名称
szDeviceType : array[0..RAS_MaxDeviceType] of char;//活动连接的所用的设备类型
szDeviceName : array[0..RAS_MaxDeviceName] of char;//活动连接的所用的设备名称
end;
type
TRASPPPIP = record//活动的拨号连接的动态IP地址信息
dwSize : DWORD;//该结构所占内存的大小(Bytes),一般设置为SizeOf(TRASPPPIP)
dwError : DWORD;//错误类型标识符
szIpAddress : array[ 0..RAS_MaxIpAddress ] of char;//活动的拨号连接的IP地址
end;
///下面定义查找文件的回调函数
type
TFindCallBack=procedure (const filename:string;const info:TSearchRec;var bQuit,bSub:boolean);
///下面是函数的接口
///使PC喇叭发声的函数，即使在Win9x下也可以，在NT中，请使用Windows.Beep(N1,N2)函数
procedure BeepEx(const feq:word=1200;const delay:word=1);
///延时函数
procedure Delay(const uDelay:dword);
///运行的时候拖动一个控件
procedure DragControl(aControl:TWincontrol);
///显示最近的操作的系统错误信息
procedure ShowErrorMessage;
///取得系统缓存的密码，好像用于拨号的
procedure GetCachedPassword(var buf:tstringlist);
///转换JPG到BMP格式
procedure JPG2BMP(const Source,Dest:string);
///转换BMP到JPG格式
procedure Bmp2Jpg(const Source,Dest:string;const scale:byte);
///FitBitmap很有用的，用来把一个图片大小改变！
procedure FitBitmap(const Source,Dest:string;const x,y:integer;const ColorBit:TPixelFormat);
///调用这个函数的程序在退出之后会自动删除Exe！
procedure DeleteMe;
///查找文件函数
procedure FindFile(var quit:boolean;const path: String;const filename:string='*.*';
proc:TFindCallBack=nil;bSub:boolean=true;const bMsg:boolean=true);
///设置分辨率
procedure SetRes(XRes, YRes: DWord);
procedure showinfo(msg:string);
///监测声卡是否存在
function SoundCardExist:boolean;
///执行一个外部程序，并且等待他的结束
Function WinExecExW(cmd,workdir:pchar;visiable:integer):DWORD;
///这个函数用在Win9x下面，可以使程序从Ctrl+Alt+Del中消失
function RegisterServiceProcess(const pid:longint;const b:longint):dword;stdcall;
///用于拨号的
function WSAEnumProtocols(lpiProtocols:integer;var lpProtocolBuffer:WSAPROTOCOL_INFOW;lpdwBufferLength:dword):integer;
///取得本机的IP地址
function GetLocalIP:string;
///从一个字符串中取得所有的数字
function GetNumFromStr(const str: String;const hex:boolean=false): String;
///分割一个字符串，其中分割的标志是ch
function SplitString(const source,ch:string):tstrings;
///读取或者写入快捷方式文件
function LinkFileInfo(const lnkFileName:string;var info:LINK_FILE_INFO;const bSet:boolean=false):boolean;
///把快捷键变成一个字符串
function ShortCutToString(const HotKey:word):string;
///创建一个快捷方式
function CreateLinkFile(const info:LINK_FILE_INFO;const DestFileName:string=''):boolean;
///生成语言ID，不过有错误，没有测试
function MakeLangID(const p,s:word):word;
///生成本地语言ID，也有错误？
function MakeLCID(const lgid,srtid:word):dword;
///运行一个DOS程序，并且取得他的输出
function RunDOS(const Prog, CommandLine,Dir: String;var ExitCode:DWORD): String;
///一个取Cache密码的函数，不过已经无效了
function WNetEnumCachedPasswords(para0: pointer; para1:word; para2: byte; para3:pointer; para4: dword): word; stdcall;
///取的汉字的拼音的首字母
function GetHzPy(const AHzStr: string): string;
///转换Ansi到Unicode
function AnsiToUnicode(Ansi: string):string;
///转换Unicode到Ansi
function UnicodeToAnsi(Unicode: string):string;
///检测文件是否正在被使用
function IsFileInUse(fName : string ) : boolean;
///获取文件的时间信息
function GetFileLastAccessTime(sFileName:string;uFlag:byte=FILE_MODIFY_TIME):TDateTime;
///获取拨号连接
function RasEnumConnections( var lprasconn : RASCONN ;var lpcb: DWORD;var lpcConnections : DWORD) : DWORD; stdcall;
function RasGetProjectionInfo(hrasconn : HRasConn;rasprojection : DWORD;var lpprojection : TRASPPPIP;var lpcb : DWord) : DWORD;stdcall;
function InternetGetConnectedState(uflag:dword;reverse:dword):boolean;stdcall;
function InetIsOffline(res:dword=0):boolean;stdcall;
///位操作
function GetBit(const x:dword;const bit:byte):dword;
///打开方式对话框
function OpenWith(h:hwnd;const filename:string):integer;
///关闭系统对话框
function SHShutDownDialog(h:integer):longint;
///格式化磁盘对话框
function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word):LongInt;stdcall;
///更改图标对话框
function SHChangeIconDialog(h:hwnd;filename:pchar; Reserved:integer;var index:integer):integer;stdcall;
///运行对话框
function SHRunDialog(h:hwnd;rev1:dword;rev2:dword=0;szTitle:pchar=nil;szPrompt:Pchar=nil;uFlag:dword=0):dword;stdcall;
///打开方式
function OpenAs_RunDLL(const h:hwnd;b:hwnd;const filename:pchar;sw:integer=SW_SHOW):integer;stdcall;
///API的打开文件对话框，支持Win2000风格
function GetFileName(const filename:string):string;
function PackFileName(const fn: string;const len:integer=67) : string;
function StringRight(s:string;count:integer;ch:char=#0):string;
function Stringleft(s:string;count:integer;ch:char=#0):string;
function Rightpos(s:string;ch:char;count:integer=1):integer;
///生成一个GUID
function GetGUID:string;
///改正的选择目录对话框
function SelectDirectory(handle:hwnd;const Caption: string; const Root: WideString;out Directory: string): Boolean;
///文件属性对话框
function SHFilePropertiesDialog(handle:hwnd;uFlags:Dword;Filename:pchar;str:pchar):dword;stdcall;
function SelectFile(handle:hwnd;Filename:pchar;sbsize:dword;initdir:pchar;fileext:pchar;filter:pchar;caption:pchar):integer;stdcall;
implementation
function SelectFile;external 'shell32.dll' index 63;
function SHFilePropertiesDialog;external 'shell32.dll' index 178;
function OpenAs_RunDLL;stdcall;external 'shell32.dll';
function SHShutDownDialog;external 'shell32.dll' index 60;
function SHRunDialog;stdcall;external 'shell32.dll' index 61;
function SHChangeIconDialog;external 'shell32.dll' index 62;
function SHFormatDrive;external 'shell32.dll' name 'SHFormatDrive';
function InetIsOffline;stdcall;external 'url.dll' name 'InetIsOffline';
function InternetGetConnectedState;stdcall;external 'wininet.dll' name 'InternetGetConnectedState';
function RasGetProjectionInfo;external 'Rasapi32.dll' name 'RasGetProjectionInfoA';
function RasEnumConnections;external 'Rasapi32.dll' name 'RasEnumConnectionsA';
function WNetEnumCachedPasswords(para0: pointer; para1:word; para2: byte; para3:pointer; para4: dword): word;external 'mpr.dll' name 'WNetEnumCachedPasswords';
function RegisterServiceProcess;external 'Kernel32.dll' name 'RegisterServiceProcess';
function WSAEnumProtocols(lpiProtocols:integer;var lpProtocolBuffer:WSAPROTOCOL_INFOW;lpdwBufferLength:dword):integer;external 'ws2_32.dll' name 'WSAEnumProtocolsA';
function SoundCardExist:boolean;
begin
result:=WaveOutGetNumDevs >0;
end;
procedure Delay(const uDelay:dword);
var
n:dword;
begin
n:=GetTickCount;
while ((GetTickCount-n)<=uDelay) do
application.ProcessMessages;
end;
procedure BeepEx(const feq:word=1200;const delay:word=1);
procedure BeepOff;
begin
asm
in al,$61;
and al,$fc;
out $61,al;
end;
end;
var
temp:word;
begin
temp:=FREQ_SCALE div feq;
asm
in al,61h;
or al,3;
out 61h,al;
mov al,$b6;
out 43h,al;
mov ax,temp;
out 42h,al;
mov al,ah;
out 42h,al;
end;
sleep(delay);
beepoff;
end;
procedure ShowErrorMessage;
var
errno:integer;
buf:array [0..255] of char;
begin
errno:=GetLastError;
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,errno,$400,buf,255,nil);
if buf<>'' then
messagebox(application.handle,pchar(string(buf)+#13+'错误代号：'+inttostr(errno)+'。'),
'信息',MB_OK+MB_ICONINFORMATION);
end;
Function WinExecExW(cmd,workdir:pchar;visiable:integer):DWORD;
var
StartupInfo:TStartupInfo;
ProcessInfo:TProcessInformation;
begin
FillChar(StartupInfo,SizeOf(StartupInfo),#0);
StartupInfo.cb:=SizeOf(StartupInfo);
StartupInfo.dwFlags:=STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow:=visiable;
if not CreateProcess(nil,cmd,nil,nil,false,Create_new_console or Normal_priority_class,nil,nil,StartupInfo,ProcessInfo) then
result:=0
else
begin
waitforsingleobject(processinfo.hProcess,INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess,Result);
end;
end;
function GetLocalIP:string;
type
TaPInAddr = array [0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe : PHostEnt;
pptr : PaPInAddr;
Buffer : array [0..63] of char;
I : Integer;
GInitData : TWSADATA;
begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe :=GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^[I] <> nil do begin
result:=StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
function GetNumFromStr(const str: String;const hex:boolean=false): String;
var
i:integer;
charset:Set of char;
begin
if hex then
charset:=['0'..'9','a'..'f','A'..'F','.']
else
charset:=['0'..'9','.'];
for i := 1 to Length(str) do
begin
if (str[i] in charset) then
result:= result + uppercase(str[i]);
end;
end;
function SplitString(const source,ch:string):tstrings;
var
temp:string;
i:integer;
begin
result:=tstringlist.Create;
temp:=source;
i:=pos(ch,source);
while i<>0 do
begin
result.Add(copy(temp,0,i-1));
delete(temp,1,i);
i:=pos(ch,temp);
end;
result.Add(temp);
end;
procedure DragControl(aControl:TWincontrol);
const sc_dragmove=$f012;
begin
releasecapture;
acontrol.Perform(wm_syscommand,sc_dragmove,0);
end;
function LinkFileInfo(const lnkFileName:string;var info:LINK_FILE_INFO;const bSet:boolean):boolean;
var
hr:hresult;
psl:IShelllink;
wfd:win32_find_data;
ppf:IPersistFile;
lpw:pwidechar;
buf:pwidechar;
begin
result:=false;
getmem(buf,MAX_PATH);
try
if SUCCEEDED(CoInitialize(nil)) then
if (succeeded(cocreateinstance(clsid_shelllink,nil,clsctx_inproc_server,IID_IShellLinkA,psl))) then
begin
hr:=psl.QueryInterface(iPersistFile,ppf);
if succeeded(hr) then
begin
lpw:=stringtowidechar(lnkfilename,buf,MAX_PATH);
hr := ppf.Load(lpw, STGM_READ);
if succeeded(hr) then
begin
hr := psl.Resolve(0, SLR_NO_UI);
if succeeded(hr) then
begin
if bSet then
begin
psl.SetArguments(info.Arguments);
psl.SetDescription(info.Description);
psl.SetHotkey(info.HotKey);
psl.SetIconLocation(info.IconLocation,info.IconIndex);
psl.SetIDList(info.ItemIDList);
psl.SetPath(info.FileName);
psl.SetShowCmd(info.ShowState);
psl.SetRelativePath(info.RelativePath,0);
psl.SetWorkingDirectory(info.WorkDirectory);
if succeeded(psl.Resolve(0,SLR_UPDATE)) then
result:=true;
end
else
begin
psl.GetPath(info.FileName,MAX_PATH, wfd,SLGP_SHORTPATH );
psl.GetIconLocation(info.IconLocation,MAX_PATH,info.IconIndex);
psl.GetWorkingDirectory(info.WorkDirectory,MAX_PATH);
psl.GetDescription(info.Description,CCH_MAXNAME);
psl.GetArguments(info.Arguments,MAX_PATH);
psl.GetHotkey(info.HotKey);
psl.GetIDList(info.ItemIDList);
psl.GetShowCmd(info.ShowState);
result:=true;
end;
end;
end;
end;
end;
finally
freemem(buf);
end;
end;
function ShortCutToString(const HotKey:word):string;
var
shift:tshiftstate;
begin
shift:=[];
if ((wordrec(HotKey).hi shr 0) and 1)<>0 then
include(shift,ssshift);
if ((wordrec(HotKey).hi shr 1) and 1)<>0 then
include(shift,ssctrl);
if ((wordrec(HotKey).hi shr 2) and 1)<>0 then
include(shift,ssalt);
result:=shortcuttotext(shortcut(wordrec(hotkey).lo,shift));
end;
function CreateLinkFile(const info:LINK_FILE_INFO;const DestFileName:string=''):boolean;
var
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -