📄 u_mainfrm.pas
字号:
ip_str_tmp3 := IntToStr(Third_IPAddress(ip));
ip_str_tmp4 := IntToStr(Fourth_IPAddress(ip));
ip_str := ip_str_tmp1 + '.' + ip_str_tmp2 + '.' + ip_str_tmp3 + '.' +
ip_str_tmp4;
ip_str := ip_str + '@' + edt_Port.Text;
m_Set.WriteString('ADDRCONF', ip_str , '');
end;
end;
procedure Tfrm_Main.cmb_timesKeyPress(Sender: TObject; var Key: Char);
begin
if not(Key in ['0'..'9',#8]) then key:=#0;
end;
procedure Tfrm_Main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
m_Set.WriteBool('SYSTEM','LONGLINK',chk_Long.Checked);
m_Infos.f_ClearData;
stop := true;
Application.ProcessMessages;
m_Infos.Free;
end;
procedure f_InsertCompToStatuBar(p_Bar: TStatusBar; p_Control: TControl;
p_Pos: Shortint);
var
v_PanelRect: TRect;
begin
CHackControl(p_Control).SetParent(p_Bar);
SendMessage(p_Bar.Handle, SB_GETRECT, p_Pos, Integer(@v_PanelRect));
p_Control.SetBounds(v_PanelRect.Left + 1,
v_PanelRect.Top + 1,
v_PanelRect.Right - v_PanelRect.Left - 2,
v_PanelRect.Bottom - v_PanelRect.Top - 2);
end;
procedure Tfrm_Main.FormCreate(Sender: TObject);
var
ip: Integer;
begin
v_IPEdit := TIpEdit.Create(Application);
v_IPEdit.Parent := edt_IPFalse.Parent;
v_IPEdit.BoundsRect := edt_IPFalse.BoundsRect;
SetWindowLong(edt_Port.Handle,GWL_Style,
(GetWindowLong(edt_Port.Handle,GWL_Style) or ES_Number or ES_RIGHT));
m_Infos := TSendInfo.Create;
lv_Result.Items.Count := m_Infos.f_GetCount();
lv_Result.Repaint;
stop := false;
m_Set := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Params.ini');
edt_Port.Text := m_Set.ReadString('SYSTEM', 'PORT', '0');
ip:=MAKEIPADDRESS(m_Set.ReadInteger('SYSTEM','HOST1',0),
m_Set.ReadInteger('SYSTEM','HOST2',0),
m_Set.ReadInteger('SYSTEM','HOST3',0),
m_Set.ReadInteger('SYSTEM','HOST4',0));
SendMessage(v_IPEdit.Handle,IPM_SETADDRESS,0,ip);
chk_Long.Checked := m_Set.ReadBool('SYSTEM','LONGLINK',False);
end;
function Tfrm_Main.f_GetIP: string;
var
ip: Integer;
IP1, IP2, IP3, IP4: ShortString;
begin
SendMessage(v_IPEdit.Handle,IPM_GETADDRESS, 0, Integer(@ip));
IP1 := IntToStr(First_IPAddress(ip));
IP2 := IntToStr(Second_IPAddress(ip));
IP3 := IntToStr(Third_IPAddress(ip));
IP4 := IntToStr(Fourth_IPAddress(ip));
Result := IP1 + '.' + IP2 + '.' + IP3 + '.' + IP4
end;
function Tfrm_Main.initWinSocket(v_host: string; v_port: Integer):boolean;
var
v_wsData: TWSAData;
v_sockfd: integer;
v_svrAddr: TSockAddr;
begin
Result := False;
WSAStartup(MakeWord(2,0),v_wsData);
v_sockfd := socket(AF_INET, SOCK_STREAM, 0);
if v_sockfd = -1 then
begin
Application.MessageBox('Socket创建失败!', '错误',
MB_OK + MB_ICONERROR);
WSAcleanup;
exit;
end;
v_svrAddr.sin_family := AF_INET;
v_svrAddr.sin_port := htons(v_port);
v_svrAddr.sin_addr.S_addr := Inet_Addr(PChar(v_host));
FillChar(v_SvrAddr.sin_zero, SizeOf(v_svrAddr.sin_zero), 0);
if connect(v_sockfd, v_SvrAddr, SizeOf(v_SvrAddr)) = -1 then
begin
Application.MessageBox('Socket连接失败!', '错误',
MB_OK + MB_ICONERROR);
if CloseSocket(v_sockfd) <> 0 then
begin
Application.MessageBox('CloseSocket失败!', '错误',
MB_OK + MB_ICONERROR);
end;
Exit;
end;
sockfd := v_sockfd;
Result := True;
end;
procedure Tfrm_Main.lv_ResultCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
with TListView(Sender).Canvas.Brush do
begin
Color := c_Colors[Odd(Item.Index)];
end;
end;
procedure Tfrm_Main.lv_ResultData(Sender: TObject; Item: TListItem);
begin
if m_Infos.f_GetDate(Item.Index) = nil then Exit;
Item.SubItems.Add(m_Infos.f_GetDate(Item.Index)^.r_String);
Item.SubItems.Add(m_Infos.f_GetDate(Item.Index)^.r_Result);
Item.ImageIndex := m_Infos.f_GetDate(Item.Index)^.r_Stat;
end;
procedure Tfrm_Main.lv_ResultMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
v_Item: TListItem;
begin
v_Item := lv_Result.GetItemAt(X, Y);
if v_Item <> nil then
begin
if m_Infos.f_GetDate(v_Item.Index) = nil then
begin
mm_Test.Clear;
edt_Result.Text := '';
end else
begin
mm_Test.Text := m_Infos.f_GetDate(v_Item.Index)^.r_String;
edt_Result.Text := m_Infos.f_GetDate(v_Item.Index)^.r_Result;
end;
end;
end;
procedure Tfrm_Main.mi_CloseClick(Sender: TObject);
begin
Application.Terminate;
end;
procedure Tfrm_Main.mm_ContentDblClick(Sender: TObject);
begin
mm_Content.Clear;
end;
procedure Tfrm_Main.SpeedButton1Click(Sender: TObject);
var
v_Frm: Tfrm_AddConf;
v_IP: TStringList;
ip: Integer;
ip1,ip2,ip3,ip4: Integer;
begin
v_Frm := Tfrm_AddConf.Create(Application);
try
v_Frm.ShowModal;
if Length(Trim(v_Frm.m_IP + v_Frm.m_Port)) <> 0 then
begin
v_IP := TStringList.Create;
v_IP.Delimiter := '.';
v_IP.DelimitedText := v_Frm.m_IP;
if v_IP.Count > 3 then
begin
if not TryStrToInt(v_IP.Strings[0],ip1) then
begin
ip1 := 0;
end;
if not TryStrToInt(v_IP.Strings[1],ip2) then
begin
ip2 := 0;
end;
if not TryStrToInt(v_IP.Strings[2],ip3) then
begin
ip3 := 0;
end;
if not TryStrToInt(v_IP.Strings[3],ip4) then
begin
ip4 := 0;
end;
ip:=MAKEIPADDRESS(ip1,ip2,ip3,ip4);
SendMessage(v_IPEdit.Handle,IPM_SETADDRESS,0,ip);
edt_Port.Text := v_Frm.m_Port;
end;
v_IP.Free;
end;
finally
v_Frm.Free;
end;
end;
procedure Tfrm_Main.tm_CountTimer(Sender: TObject);
begin
stat_Main.Panels.Items[0].Text := '每秒处理约为:' + IntToStr(new - old) + '条 ';
if (new - old) <> 0 then
begin
stat_Main.Panels.Items[0].Text := stat_Main.Panels.Items[0].Text + '预计结束时间' +
IntToStr((gg_Main.MaxValue-new) div (new - old)) +'秒';
end;
old := new;
end;
{ TSendInfo }
constructor TSendInfo.Create();
begin
inherited;
m_List := TList.Create;
end;
destructor TSendInfo.Destroy;
begin
f_ClearData();
inherited;
end;
procedure TSendInfo.f_AddInfo(p_Infos: string);
var
v_Ptr: PSendInfo;
begin
New(v_Ptr);
v_Ptr^.r_String := p_Infos;
v_Ptr^.r_Result := '待发送';
v_Ptr^.r_Stat := 0;
m_List.Add(v_Ptr);
end;
procedure TSendInfo.f_ClearData;
var
v_Count: Integer;
v_Ptr: PSendInfo;
begin
for v_Count := 0 to m_List.Count - 1 do
begin
v_Ptr := PSendInfo(m_List.Items[v_Count]);
Application.ProcessMessages;
Dispose(v_Ptr);
end;
m_List.Clear;
end;
function TSendInfo.f_GetCount: Integer;
begin
Result := m_List.Count;
end;
function TSendInfo.f_GetDate(index: Integer): PSendInfo;
begin
if index < m_List.Count then
begin
Result := PSendInfo(m_List.Items[index]);
end else
Result := nil;
end;
procedure TSendInfo.f_SetIndex(index, stat: Integer);
begin
if index < m_List.Count then
begin
PSendInfo(m_List.Items[index])^.r_Stat := stat;
end;
end;
procedure TSendInfo.f_SetReslut(index: Integer; result: string);
begin
if index < m_List.Count then
begin
PSendInfo(m_List.Items[index])^.r_Result := result;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -