能够延时启动程序的一个小软件(0分)

  • 主题发起人 主题发起人 delphiwolf
  • 开始时间 开始时间
D

delphiwolf

Unregistered / Unconfirmed
GUEST, unregistred user!
为了自己方便写的,顺便发布出来。
program DelayLauncher;
uses
Forms, SysUtils,
Main in 'Main.pas' {MainForm},
Tools in '../Tools/Tools.pas';
{$R *.res}
begin
if FindCmdLineSwitch('Start') then
begin
TMainForm.Startup;
end
else
begin
Application.Initialize;
Application.Title := 'DelayLauncher';
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end;
end.

 
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.

 
object MainForm: TMainForm
Left = 925
Top = 341
Width = 400
Height = 300
BorderWidth = 10
Caption = 'DelayLauncher'
Color = clBtnFace
do
ckSite = True
DragMode = dmAutomatic
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
Menu = MainMenu
OldCreateOrder = False
Position = poScreenCenter
OnCloseQuery = FormCloseQuery
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object LauncherMemo: TMemo
Left = 0
Top = 0
Width = 372
Height = 226
Align = alClient
Lines.Strings = (
'10 "G:/DxgWork/MonitorPower/MonitorPower.exe" /off'
'3 G:/DxgWork/MonitorPower/MonitorPower.exe /on')
ScrollBars = ssBoth
TabOrder = 0
WordWrap = False
end
object Timer: TTimer
Enabled = False
OnTimer = TimerTimer
Left = 61
Top = 20
end
object MainMenu: TMainMenu
Left = 96
Top = 20
object FileMenuItem: TMenuItem
Caption = 'File'
object OpenMenuItem: TMenuItem
Caption = 'Open'
OnClick = OpenMenuItemClick
end
object SaveMenuItem: TMenuItem
Caption = 'Save'
OnClick = SaveMenuItemClick
end
object RunMenuItem: TMenuItem
Caption = 'Run'
OnClick = RunMenuItemClick
end
object N1: TMenuItem
Caption = '-'
end
object ExitMenuItem: TMenuItem
Caption = 'Exit'
OnClick = ExitMenuItemClick
end
end
object OptionsMenuItem: TMenuItem
Caption = 'Options'
object StartupMenuItem: TMenuItem
Caption = 'Startup'
OnClick = StartupMenuItemClick
end
end
object HelpMenuItem: TMenuItem
Caption = 'Help'
object AboutMenuItem: TMenuItem
Caption = 'About'
OnClick = AboutMenuItemClick
end
end
end
end
 
后退
顶部