?? scktmain.pas
字號(hào):
end;
procedure TSocketForm.SetItemIndex(Value: Integer);
var
Selected: Boolean;
begin
if (FCurItem <> Value) then
try
if ApplyAction.Enabled then ApplyAction.Execute;
except
PortList.ItemIndex := FCurItem;
raise;
end else
Exit;
if Value = -1 then Value := 0;
PortList.ItemIndex := Value;
FCurItem := PortList.ItemIndex;
Selected := FCurItem <> -1;
if Selected then
with TSocketDispatcher(PortList.Items.Objects[FCurItem]) do
begin
PortUpDown.Position := Port;
ThreadUpDown.Position := ThreadCacheSize;
Self.InterceptGUID.Text := FInterceptGUID;
TimeoutUpDown.Position := Timeout;
ClearModifications;
end;
PortNo.Enabled := Selected;
ThreadSize.Enabled := Selected;
Timeout.Enabled := Selected;
InterceptGUID.Enabled := Selected;
end;
function TSocketForm.GetSelectedSocket: TServerSocket;
begin
Result := TServerSocket(PortList.Items.Objects[ItemIndex]);
end;
procedure TSocketForm.UIInitialize(var Message: TMessage);
begin
Initialize(Message.WParam <> 0);
end;
procedure TSocketForm.Initialize(FromService: Boolean);
function IE4Installed: Boolean;
var
RegKey: HKEY;
begin
Result := False;
if RegOpenKey(HKEY_LOCAL_MACHINE, KEY_IE, RegKey) = ERROR_SUCCESS then
try
Result := RegQueryValueEx(RegKey, 'Version', nil, nil, nil, nil) = ERROR_SUCCESS;
finally
RegCloseKey(RegKey);
end;
end;
begin
FFromService := FromService;
NT351 := (Win32MajorVersion <= 3) and (Win32Platform = VER_PLATFORM_WIN32_NT);
if NT351 then
begin
if not FromService then
raise Exception.CreateRes(@SServiceOnly);
BorderIcons := BorderIcons + [biMinimize];
BorderStyle := bsSingle;
end;
ReadSettings;
if FromService then
begin
miClose.Visible := False;
N1.Visible := False;
end;
UpdateStatus;
AddIcon;
if IE4Installed then
FTaskMessage := RegisterWindowMessage('TaskbarCreated') else
UpdateTimer.Enabled := True;
end;
procedure TSocketForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
var
TimerEnabled: Boolean;
begin
TimerEnabled := UpdateTimer.Enabled;
UpdateTimer.Enabled := False;
try
CanClose := False;
if ApplyAction.Enabled then ApplyAction.Execute;
if FClosing and (not FFromService) and (ConnectionList.Items.Count > 0) then
begin
FClosing := False;
if MessageDlg(SErrClose, mtConfirmation, [mbYes, mbNo], 0) <> idYes then
Exit;
end;
WriteSettings;
CanClose := True;
finally
if TimerEnabled and (not CanClose) then
UpdateTimer.Enabled := True;
end;
end;
procedure TSocketForm.FormDestroy(Sender: TObject);
var
i: Integer;
begin
UpdateTimer.Enabled := False;
if not NT351 then
Shell_NotifyIcon(NIM_DELETE, @FIconData);
for i := 0 to PortList.Items.Count - 1 do
PortList.Items.Objects[i].Free;
end;
procedure TSocketForm.AddIcon;
begin
if not NT351 then
begin
with FIconData do
begin
cbSize := SizeOf(FIconData);
Wnd := Self.Handle;
uID := $DEDB;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
hIcon := Forms.Application.Icon.Handle;
uCallbackMessage := WM_MIDASICON;
StrCopy(szTip, PChar(Caption));
end;
Shell_NotifyIcon(NIM_Add, @FIconData);
end;
end;
procedure TSocketForm.ReadSettings;
var
Reg: TRegINIFile;
procedure CreateItem(ID: Integer);
var
SH: TSocketDispatcher;
begin
SH := TSocketDispatcher.Create(nil);
SH.ReadSettings(ID, Reg);
PortList.Items.AddObject(IntToStr(SH.Port), SH);
try
SH.Open;
except
on E: Exception do
raise Exception.CreateResFmt(@SOpenError, [SH.Port, E.Message]);
end;
end;
var
Sections: TStringList;
i: Integer;
begin
Reg := TRegINIFile.Create('');
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey(KEY_SOCKETSERVER, True);
Sections := TStringList.Create;
try
Reg.ReadSections(Sections);
if Sections.Count > 1 then
begin
for i := 0 to Sections.Count - 1 do
if CompareText(Sections[i], csSettings) <> 0 then
CreateItem(StrToInt(Sections[i]));
end else
CreateItem(-1);
ItemIndex := 0;
ShowHostAction.Checked := Reg.ReadBool(csSettings, ckShowHost, False);
RegisteredAction.Checked := Reg.ReadBool(csSettings, ckRegistered, True);
finally
Sections.Free;
end;
finally
Reg.Free;
end;
end;
procedure TSocketForm.WriteSettings;
var
Reg: TRegINIFile;
Sections: TStringList;
i: Integer;
begin
Reg := TRegINIFile.Create('');
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey(KEY_SOCKETSERVER, True);
Sections := TStringList.Create;
try
Reg.ReadSections(Sections);
for i := 0 to Sections.Count - 1 do
TRegistry(Reg).DeleteKey(Sections[i]);
finally
Sections.Free;
end;
for i := 0 to PortList.Items.Count - 1 do
TSocketDispatcher(PortList.Items.Objects[i]).WriteSettings(Reg);
Reg.WriteBool(csSettings, ckShowHost, ShowHostAction.Checked);
Reg.WriteBool(csSettings, ckRegistered, RegisteredAction.Checked);
finally
Reg.Free;
end;
end;
procedure TSocketForm.miCloseClick(Sender: TObject);
begin
FClosing := True;
Close;
end;
procedure TSocketForm.WMMIDASIcon(var Message: TMessage);
var
pt: TPoint;
begin
case Message.LParam of
WM_RBUTTONUP:
begin
if not Visible then
begin
SetForegroundWindow(Handle);
GetCursorPos(pt);
PopupMenu.Popup(pt.x, pt.y);
end else
SetForegroundWindow(Handle);
end;
WM_LBUTTONDBLCLK:
if Visible then
SetForegroundWindow(Handle) else
miPropertiesClick(nil);
end;
end;
procedure TSocketForm.miPropertiesClick(Sender: TObject);
begin
ShowModal;
end;
procedure TSocketForm.FormShow(Sender: TObject);
begin
Pages.ActivePage := Pages.Pages[0];
end;
procedure TSocketForm.UpdateStatus;
begin
UserStatus.SimpleText := Format(SStatusLine,[ConnectionList.Items.Count]);
end;
procedure TSocketForm.AddClient(Thread: TServerClientThread);
var
Item: TListItem;
begin
Item := ConnectionList.Items.Add;
Item.Caption := IntToStr(Thread.ClientSocket.LocalPort);
Item.SubItems.Add(Thread.ClientSocket.RemoteAddress);
if ShowHostAction.Checked then
begin
Item.SubItems.Add(Thread.ClientSocket.RemoteHost);
if Item.SubItems[1] = '' then Item.SubItems[1] := SHostUnknown;
end else
Item.SubItems.Add(SNotShown);
if Thread is TSocketDispatcherThread then
Item.SubItems.Add(DateTimeToStr(TSocketDispatcherThread(Thread).LastActivity));
Item.Data := Pointer(Thread);
UpdateStatus;
end;
procedure TSocketForm.RemoveClient(Thread: TServerClientThread);
var
Item: TListItem;
begin
Item := ConnectionList.FindData(0, Thread, True, False);
if Assigned(Item) then Item.Free;
UpdateStatus;
end;
procedure TSocketForm.miDisconnectClick(Sender: TObject);
var
i: Integer;
begin
if MessageDlg(SQueryDisconnect, mtConfirmation, [mbYes, mbNo], 0) = mrNo then
Exit;
with SelectedSocket.Socket do
begin
Lock;
try
for i := 0 to ConnectionList.Items.Count - 1 do
with ConnectionList.Items[i] do
if Selected then
TServerClientThread(Data).ClientSocket.Close;
finally
Unlock;
end;
end;
end;
procedure TSocketForm.miExitClick(Sender: TObject);
begin
CheckValues;
ModalResult := mrOK;
end;
procedure TSocketForm.ApplyActionExecute(Sender: TObject);
begin
with TSocketDispatcher(SelectedSocket) do
begin
if Socket.ActiveConnections > 0 then
if MessageDlg(SErrChangeSettings, mtConfirmation, [mbYes, mbNo], 0) = idNo then
Exit;
Close;
Port := StrToInt(PortNo.Text);
PortList.Items[ItemIndex] := PortNo.Text;
ThreadCacheSize := StrToInt(ThreadSize.Text);
InterceptGUID := Self.InterceptGUID.Text;
Timeout := StrToInt(Self.Timeout.Text);
Open;
end;
ClearModifications;
end;
procedure TSocketForm.ApplyActionUpdate(Sender: TObject);
begin
ApplyAction.Enabled := PortNo.Modified or ThreadSize.Modified or
Timeout.Modified or InterceptGUID.Modified;
end;
procedure TSocketForm.ClearModifications;
begin
PortNo.Modified := False;
ThreadSize.Modified := False;
Timeout.Modified := False;
InterceptGUID.Modified := False;
end;
procedure TSocketForm.DisconnectActionUpdate(Sender: TObject);
begin
DisconnectAction.Enabled := ConnectionList.SelCount > 0;
end;
procedure TSocketForm.ShowHostActionExecute(Sender: TObject);
var
i: Integer;
Item: TListItem;
begin
ShowHostAction.Checked := not ShowHostAction.Checked;
ConnectionList.Items.BeginUpdate;
try
for i := 0 to ConnectionList.Items.Count - 1 do
begin
Item := ConnectionList.Items[i];
if ShowHostAction.Checked then
begin
Item.SubItems[1] := TServerClientThread(Item.Data).ClientSocket.RemoteHost;
if Item.SubItems[1] = '' then Item.SubItems[1] := SHostUnknown;
end else
Item.SubItems[1] := SNotShown;
end;
finally
ConnectionList.Items.EndUpdate;
end;
end;
procedure TSocketForm.miAddClick(Sender: TObject);
var
SD: TSocketDispatcher;
Idx: Integer;
begin
CheckValues;
SD := TSocketDispatcher.Create(nil);
SD.Port := PortUpDown.Position + 1;
PortUpDown.Position := SD.Port;
Idx := PortList.Items.AddObject(PortNo.Text,SD);
PortNo.Modified := True;
ItemIndex := Idx;
Pages.ActivePage := Pages.Pages[0];
PortNo.SetFocus;
end;
procedure TSocketForm.RemovePortActionUpdate(Sender: TObject);
begin
RemovePortAction.Enabled := (PortList.Items.Count > 1) and (ItemIndex <> -1);
end;
procedure TSocketForm.RemovePortActionExecute(Sender: TObject);
begin
CheckValues;
PortList.Items.Objects[ItemIndex].Free;
PortList.Items.Delete(ItemIndex);
FCurItem := -1;
ItemIndex := 0;
end;
procedure TSocketForm.UpDownClick(Sender: TObject; Button: TUDBtnType);
begin
((Sender as TUpDown).Associate as TEdit).Modified := True;
end;
procedure TSocketForm.PortListClick(Sender: TObject);
begin
ItemIndex := PortList.ItemIndex;
end;
procedure TSocketForm.ConnectionListCompare(Sender: TObject; Item1,
Item2: TListItem; Data: Integer; var Compare: Integer);
begin
if Data = -1 then
Compare := AnsiCompareText(Item1.Caption, Item2.Caption) else
Compare := AnsiCompareText(Item1.SubItems[Data], Item2.SubItems[Data]);
end;
procedure TSocketForm.ConnectionListColumnClick(Sender: TObject;
Column: TListColumn);
begin
FSortCol := Column.Index - 1;
ConnectionList.CustomSort(nil, FSortCol);
end;
procedure TSocketForm.IntegerExit(Sender: TObject);
begin
try
StrToInt(PortNo.Text);
except
ActiveControl := PortNo;
raise;
end;
end;
procedure TSocketForm.RegisteredActionExecute(Sender: TObject);
begin
RegisteredAction.Checked := not RegisteredAction.Checked;
ShowMessage(SNotUntilRestart);
end;
procedure TSocketForm.AllowXMLExecute(Sender: TObject);
begin
AllowXML.Checked := not AllowXML.Checked;
end;
procedure TSocketForm.About2Click(Sender: TObject);
begin
{
ShowMessage('This Software is no original from borland, this is a beta version'#13 +
'Please if you get erros send report to Manuel Parma mparma@usa.net'#13 +
'Disclaimer: This program is provided "as is"! only for testing.'#13 +
'The author takes no responsibility for use or misuse of this program. Use the program at your own risk.'#13 +
'The code and text in this program is not associated with Borland.'#13 +
'License: The program may not be distributed, as it is bound by the terms and conditions of Borland product license.'#13 +
'Manuel Parma mparma@usa.net'#13'2002-07-05'); }
end;
procedure TSocketForm.FormActivate(Sender: TObject);
begin
About2Click(sender);
end;
end.
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -