Delphi software that triggers custom protocols through URLs

{
*
*
* File name: umainform. Pas
* File type: Delphi code file
*
* File version: 0.1
* Author: Yu Wei
* Completion time;
* Contact: yu924@hotmail.com
* QQ: 183088201
*
*
}

Unit umainform;

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, comctrls, stdctrls, registry, extctrls;

Type
Tmainform = Class (tform)
Statusbar1: tstatusbar;
Groupbox1: tgroupbox;
Btnregprotocol: tbutton;
Btnunregprotocol: tbutton;
Btnclose: tbutton;
Label1: tlabel;
Label2: tlabel;
Txtprotocolname: tedit;
Txtprotocolapplication: tedit;
Btnbrowser: tbutton;
Chkuseasparams: tcheckbox;
Pnlprotocolurl: tpanel;
Procedure btncloseclick (Sender: tobject );
Procedure btnbrowserclick (Sender: tobject );
Procedure btnregprotocolclick (Sender: tobject );
Procedure btnunregprotocolclick (Sender: tobject );
Procedure formcreate (Sender: tobject );
Private
{Private Declarations}
Function regurlprotocol (aprotocolname, aprotocolapplicationname: string; auseparam: Boolean): Boolean;
Function unregurlprotocl (aprotocolname: string): Boolean;
Public
{Public declarations}
End;

VaR
Mainform: tmainform;

Implementation

{$ R *. DFM}

Procedure tmainform. btncloseclick (Sender: tobject );
Begin
Close;
End;

Procedure tmainform. btnbrowserclick (Sender: tobject );
VaR
Opendlg: topendialog;
Strfilename: string;
Begin
Opendlg: = topendialog. Create (NiL );
Try
Opendlg. filter: = 'Protocol file (*. EXE) | *. exe | all files (*. *) | *.*';
Opendlg. defaultext: = '*. EXE ';
If opendlg. Execute then
Begin
Strfilename: = trim (opendlg. filename );
If strfilename <> ''then
Begin
Txtprotocolapplication. Text: = strfilename;
End;
End;
Finally
Freeandnil (opendlg );
End;
End;

Procedure tmainform. btnregprotocolclick (Sender: tobject );
VaR
Strprotocolname, strprotocolapplication: string;
Begin
Strprotocolname: = trim (txtprotocolname. Text );
Strprotocolapplication: = trim (txtprotocolapplication. Text );
If strprotocolname = ''then
Begin
MessageBox (handle, 'Enter the protocol name. ', 'notification', mb_ OK + mb_iconwarning );
Exit;
End;
If strprotocolapplication = ''then
Begin
MessageBox (handle, 'set protocol program. ', 'notification', mb_ OK + mb_iconwarning );
Exit;
End;
If regurlprotocol (strprotocolname, strprotocolapplication, chkuseasparams. Checked) then
Begin
MessageBox (handle, 'user-Defined Protocol registered successfully. ', 'hs', mb_ OK + mb_iconinformation );
Exit;
End;
End;

Function tmainform. regurlprotocol (aprotocolname,
Aprotocolapplicationname: string; auseparam: Boolean): Boolean;
VaR
Objreg: Tregistry;
Begin
Result: = false;
Objreg: = Tregistry. Create;
Try
Objreg. rootkey: = hkey_classes_root;
If objreg. openkey ('/' + aprotocolname, true) then
Begin
Objreg. writestring ('', aprotocolname + 'protocol ');
Objreg. writestring ('url Protocol', aprotocolapplicationname );
If objreg. openkey ('/' + aprotocolname + '/defaulticon', true) then
Begin
Objreg. writestring ('', aprotocolapplicationname + ', 1 ');
End;
If objreg. openkey ('/' + aprotocolname + '/Shell/Open/command', true) then
Begin
If auseparam then
Objreg. writestring ('', '"' + aprotocolapplicationname + '"" % 1 "')
Else
Objreg. writestring ('', '"' + aprotocolapplicationname + '"');
End;
Result: = true;
End;
Finally
Freeandnil (objreg );
End;
End;

Function tmainform. unregurlprotocl (aprotocolname: string): Boolean;
VaR
Objreg: Tregistry;
Begin
Result: = false;
Objreg: = Tregistry. Create;
Try
Objreg. rootkey: = hkey_classes_root;
Objreg. deletekey (aprotocolname );
Result: = true;
Finally
Freeandnil (objreg );
End;
End;

Procedure tmainform. btnunregprotocolclick (Sender: tobject );
VaR
Strprotocolname: string;
Begin
Strprotocolname: = trim (txtprotocolname. Text );
If strprotocolname = ''then
Begin
MessageBox (handle, 'Enter the protocol name. ', 'notification', mb_ OK + mb_iconwarning );
Exit;
End;
If unregurlprotocl (strprotocolname) then
Begin
MessageBox (handle, 'user-Defined Protocol uninstalled successfully. ', 'hs', mb_ OK + mb_iconinformation );
Exit;
End;
End;

Procedure tmainform. formcreate (Sender: tobject );
Begin
Pnlprotocolurl. Caption: = paramstr (1 );
End;

End.