unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ExtCtrls, ShellAPI, CSIntf, Registry;
type
TLauncherRec = record
Interval: Integer;
FileName: string;
Parameters: string;
end;
TMainForm = class(TForm)
LauncherMemo: TMemo;
Timer: TTimer;
MainMenu: TMainMenu;
FileMenuItem: TMenuItem;
OpenMenuItem: TMenuItem;
SaveMenuItem: TMenuItem;
RunMenuItem: TMenuItem;
N1: TMenuItem;
ExitMenuItem: TMenuItem;
HelpMenuItem: TMenuItem;
AboutMenuItem: TMenuItem;
OptionsMenuItem: TMenuItem;
StartupMenuItem: TMenuItem;
procedure RunMenuItemClick(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure OpenMenuItemClick(Sender: TObject);
procedure SaveMenuItemClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure StartupMenuItemClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure AboutMenuItemClick(Sender: TObject);
procedure ExitMenuItemClick(Sender: TObject);
private
{ Private declarations }
FIndex: Integer;
FLauncherRec: TLauncherRec;
class function StrToLauncherRec(AStr: string): TLauncherRec;
function RegStartup(AReg: Boolean;
ACheck: Boolean = False): Boolean;
public
{ Public declarations }
class procedure Startup;
end;
var
MainForm: TMainForm;
const
RegName = 'DelayLauncher';
implementation
{$R *.dfm}
class function TMainForm.StrToLauncherRec(AStr: string): TLauncherRec;
var
P, S: PChar;
CharSet: TSysCharSet;
procedure SkipBlanks;
begin
while (P^ in [' ', Chr(VK_TAB)])do
Inc(P);
end;
begin
AStr := Trim(AStr);
P := PChar(AStr);
Result.Interval := 0;
while P^ in ['0'..'9']do
begin
Result.Interval := Result.Interval * 10 + (Ord(P^) - Ord('0'));
Inc(P);
end;
if Result.Interval = 0 then
Result.Interval := 1;
SkipBlanks;
S := P;
if P^ = '"' then
CharSet := ['"']
else
CharSet := [' ', Chr(VK_TAB), #0];
Inc(P);
while Truedo
begin
if P^ in CharSet then
begin
Inc(P);
Break;
end
else
if P^ in [#0] then
begin
CodeSite.SendError('''"''没有成对出现');
end;
Inc(P);
end;
Result.FileName := Trim(Copy(S, 1, Length(S) - Length(P)));
Result.Parameters := Trim(P);
end;
procedure TMainForm.RunMenuItemClick(Sender: TObject);
begin
FIndex := 0;
Timer.Interval := 100;
Timer.Enabled := True;
end;
procedure TMainForm.TimerTimer(Sender: TObject);
begin
Timer.Enabled := False;
if FIndex > 0 then
ShellExecute(Handle, nil, PChar(FLauncherRec.FileName), PChar(FLauncherRec.Parameters), nil, SW_SHOWNORMAL);
if FIndex < LauncherMemo.Lines.Count then
begin
FLauncherRec := StrToLauncherRec(LauncherMemo.Lines[FIndex]);
Inc(FIndex);
CodeSite.SendMsg(IntToStr(FLauncherRec.Interval) + #13#10 + FLauncherRec.FileName + #13#10 + FLauncherRec.Parameters);
Timer.Interval := FLauncherRec.Interval * 1000;
Timer.Enabled := True;
end;
end;
procedure TMainForm.OpenMenuItemClick(Sender: TObject);
begin
LauncherMemo.Lines.LoadFromFile(ChangeFileExt(Application.ExeName, '.ini'));
end;
procedure TMainForm.SaveMenuItemClick(Sender: TObject);
begin
LauncherMemo.Lines.SaveToFile(ChangeFileExt(Application.ExeName, '.ini'));
LauncherMemo.Modified := False;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if LauncherMemo.Modified then
begin
case MessageDlg('文件内容已经改变,是否保存?', mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
mrYes: SaveMenuItem.Click;
mrNo: ;
else
CanClose := False;
end;
end;
end;
procedure TMainForm.StartupMenuItemClick(Sender: TObject);
begin
StartupMenuItem.Checked := RegStartup(not StartupMenuItem.Checked);
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
StartupMenuItem.Checked := RegStartup(True, True);
OpenMenuItem.Click;
end;
procedure TMainForm.AboutMenuItemClick(Sender: TObject);
begin
MessageDlg('版本:0.9'+#13+#10+'作者:noctwolf'+#13+#10+'电子邮件:noctwolf@gmail.com', mtInformation, [mbOK], 0);
end;
class procedure TMainForm.Startup;
var
Strings: TStrings;
I: Integer;
LauncherRec: TLauncherRec;
begin
Strings := TStringList.Create;
try
try
Strings.LoadFromFile(ChangeFileExt(Application.ExeName, '.ini'));
except
Strings.Append('"' + Application.ExeName + '"');
end;
for I := 0 to Strings.Count - 1do
begin
LauncherRec := StrToLauncherRec(Strings);
Sleep(LauncherRec.Interval * 1000);
ShellExecute(0, nil, PChar(LauncherRec.FileName), PChar(LauncherRec.Parameters), nil, SW_SHOWNORMAL);
CodeSite.SendMsg(IntToStr(LauncherRec.Interval) + #13#10 + LauncherRec.FileName + #13#10 + LauncherRec.Parameters);
end;
finally
Strings.Free;
end;
end;
function TMainForm.RegStartup(AReg, ACheck: Boolean): Boolean;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('/Software/Microsoft/Windows/CurrentVersion/Run', True) then
begin
if ACheck then
AReg := Reg.ValueExists(RegName);
if AReg then
Reg.WriteString(RegName, '"' + Application.ExeName + '" /Start')
else
Reg.DeleteValue(RegName);
Reg.CloseKey;
end;
finally
Reg.Free;
end;
Result := AReg;
end;
procedure TMainForm.ExitMenuItemClick(Sender: TObject);
begin
Close;
end;
end.