📄 okunit.pas
字号:
unit okunit;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls,comobj,activex,shlobj, Gauges, DisplaySwitcher,
Animate, GIFCtrl;
type
TOK = class(TForm)
Panel1: TPanel;
Bevel1: TBevel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
dsp: TDisplaySwitcher;
RxGIFAnimator1: TRxGIFAnimator;
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
OK: TOK;
implementation
{$R *.DFM}
procedure createlink(programpath,programarg,linkpath,descr:string);
var
anobj:iunknown;
shelllink:ishelllink;
afile:ipersistfile;
FileName:WideString;
begin
if uppercase(extractfileext(linkpath))<>'.LNK' then
begin
raise Exception.Create('快捷方式的扩展名必须是"lnk"!');
end;
try
oleinitialize(nil);
anobj:=createcomobject(clsid_shelllink);
shelllink:=anobj as ishelllink;
afile:=anobj as ipersistfile;
shelllink.setpath(PChar(programpath));
shelllink.setarguments(PChar(programarg));
shelllink.SetDescription(PChar(descr));
shelllink.SetHotkey(vk_F11);
// shelllink.SetRelativePath(PChar(programarg),1);
// shelllink.SetShowCmd(1);
shelllink.SetWorkingDirectory(PChar(ExtractFileDir(Application.EXEName)));
FileName:=linkpath;
afile.Save(pwidechar(FileName),false);
finally
oleuninitialize;
end;
end;
procedure TOK.FormShow(Sender: TObject);
var
tmp:array[0..max_path] of char;
windir:string;
begin
getwindowsdirectory(tmp,max_path);
windir:=string(tmp);
begin
begin
abort;
end;
if Length(windir)>3 then
windir:=windir+'\';
createlink(ParamStr(0),'献给我可爱的小儿子:范润泽 !!!',windir+'Desktop\'+'龙矿集团工资系统 2001'+'.LNK','Application.title');
end;
end;
{procedure GetDiskInfo;
var TmpStr: string;
RootPathName: Pchar;
SectorsPerCluster,
BytesPerSector,
FreeClusters,
TotalClusters,
FreeBytes,
TotalBytes : DWORD;
begin
// with SysInfoRec do begin
RootPathName := Pchar('C:\');
if GetDiskFreeSpace( RootPathName, SectorsPerCluster,
BytesPerSector, FreeClusters,
TotalClusters ) then;
FreeBytes := SectorsPerCluster * BytesPerSector * FreeClusters;
TotalBytes := SectorsPerCluster * BytesPerSector * TotalClusters;}
// end; {- with }
//end; {- GetDiskInfo }
procedure TOK.FormCreate(Sender: TObject);
var
//TmpStr: string;
RootPathName: Pchar;
SectorsPerCluster,
BytesPerSector,
FreeClusters,
TotalClusters,
FreeBytes,
TotalBytes : DWORD;
tempdir:array[0..255] of char;
txyza:file;
begin
if (dsp.CurrentWidth<>800) or (dsp.CurrentHeight<>600) then
application.MessageBox(pchar('本程序在800*600分辨率下可获得最佳效果.目前您的显示器分辨率为:'+inttostr(dsp.CurrentWidth)+'*'+inttostr(dsp.CurrentHeight)),'注意',mb_ok+mb_iconinformation);
if not (fileexists(ExtractFileDir(Application.EXEName)+'\Print.txt')) then
begin
try
assignfile(txyza,'Print.Txt');
rewrite(txyza);
except
end;
end;
gettemppath(255,@tempdir);
RootPathName := PChar(copy(tempdir,1,3));
if GetDiskFreeSpace( RootPathName, SectorsPerCluster,
BytesPerSector, FreeClusters,
TotalClusters ) then;
FreeBytes := SectorsPerCluster * BytesPerSector * FreeClusters;
TotalBytes := SectorsPerCluster * BytesPerSector * TotalClusters;
if freebytes<50000000 then
begin
application.messagebox(pchar(RootPathName+'盘空间为:'+floattostr(totalbytes/1000000)+'兆字节,'+RootPathName+'盘剩余空间为:'+floattostr(freebytes/1000000)+'兆字节,不足于运行本软件,本软件需要至少50MB,请运行本软件附带的工具<垃圾清理工>或者删除一些没用的程序或者清空回收站!!!'),'龙矿集团工资系统 2000',mb_ok+mb_iconstop);
end;
if not (fileexists(ExtractFileDir(Application.EXEName)+'\utd.db')) then
label1.Caption:='您是第一次运行本程序,正在建立基本数据...';
label1.Update;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -