u_mainfrm.pas.~176~

使用delphi编写的简单socket请求发送工具TCP协议

unit u_MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, CommCtrl, Winsock, ImgList, Menus,
  IniFiles, Gauges, XPMan, Buttons;

const
  c_Colors: array [Boolean] of TColor = ($00E1FFF9, $00FFEBDF);


type
  TIpEdit = class(TEdit)
    procedure CreateParams(var Params: TCreateParams); override;
  end;

  CHackControl = class(TControl);

  RSendInfo = record
    r_String: String;
    r_Result: String;
    r_Stat:   Integer;
  end;
  PSendInfo = ^RSendInfo;

  TSendInfo = class(TObject)
  private
    m_List: TList;
  public
    constructor Create();
    destructor  Destroy; override;

    procedure f_AddInfo(p_Infos: string);
    function  f_GetCount():Integer;
    function  f_GetDate(index: Integer): PSendInfo;
    procedure f_ClearData();
    procedure f_SetIndex(index: Integer; stat: Integer);
    procedure f_SetReslut(index: Integer; result: string);
  end;

  Tfrm_Main = class(TForm)
    pnl_Task: TPanel;
    lv_Result: TListView;
    Label1: TLabel;
    edt_IPFalse: TEdit;
    lb_Port: TLabel;
    edt_Port: TEdit;
    btn_Test: TButton;
    sp_1: TShape;
    lb_Content: TLabel;
    mm_Content: TMemo;
    lb_Repeat: TLabel;
    cmb_times: TComboBox;
    btn_Load: TButton;
    btn_Clear: TButton;
    il_Main: TImageList;
    lb_Text: TLabel;
    mm_Test: TMemo;
    lb_Result: TLabel;
    edt_Result: TEdit;
    stat_Main: TStatusBar;
    mm_File: TMainMenu;
    N1: TMenuItem;
    btn_Send: TButton;
    gg_Main: TGauge;
    btn_Close: TButton;
    mi_Close: TMenuItem;
    xp_Main: TXPManifest;
    tm_Count: TTimer;
    chk_Long: TCheckBox;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure btn_TestClick(Sender: TObject);
    procedure cmb_timesKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btn_LoadClick(Sender: TObject);
    procedure lv_ResultData(Sender: TObject; Item: TListItem);
    procedure btn_ClearClick(Sender: TObject);
    procedure lv_ResultMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btn_SendClick(Sender: TObject);
    procedure lv_ResultCustomDrawItem(Sender: TCustomListView; Item: TListItem;
      State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure btn_CloseClick(Sender: TObject);
    procedure mi_CloseClick(Sender: TObject);
    procedure mm_ContentDblClick(Sender: TObject);
    procedure tm_CountTimer(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
    v_IPEdit: TIpEdit;
    m_Infos:  TSendInfo;
    m_Set:    TIniFile;

    sockfd:  integer;
    str2: array[1..1023] of Char;
    stop:    Boolean;

    old,new: Integer;
    function f_GetIP(): string;
    function initWinSocket(v_host: string; v_port: Integer):boolean;
  public
    { Public declarations }
  end;



var
  frm_Main: Tfrm_Main;

implementation

uses u_AddConf;

{$R *.dfm}

{ TIpEdit }

procedure TIpEdit.CreateParams(var Params: TCreateParams);
begin
  InitCommonControl(ICC_INTERNET_CLASSES);
  inherited CreateParams(Params);
  CreateSubClass(Params, WC_IPADDRESS);
end;

procedure Tfrm_Main.btn_ClearClick(Sender: TObject);
begin
  m_Infos.f_ClearData;
  lv_Result.Items.Count := m_Infos.f_GetCount();
  lv_Result.Repaint;
  edt_Result.Text := '';
  mm_Test.Text    := '';
  gg_Main.Progress := 1;
end;

procedure Tfrm_Main.btn_CloseClick(Sender: TObject);
begin
  stop := true;
  Application.ProcessMessages;
  Self.Close;
end;

procedure Tfrm_Main.btn_LoadClick(Sender: TObject);
var
  v_Count: Integer;
begin
  if Length(Trim(mm_Content.Text)) <> 0 then
  begin
    for v_Count := 0 to StrToIntDef(cmb_times.Text, 0) - 1 do
    begin
      Application.ProcessMessages;
      m_Infos.f_AddInfo(mm_Content.Text);
    end;
    lv_Result.Items.Count := m_Infos.f_GetCount();
    lv_Result.Repaint;
  end;
end;

function WinsockEnabled(): boolean;
var
  wsaData: TWSAData; 
begin 
    result := true;
    case Winsock.WSAStartup(MakeWord(2,0),wsaData) of
       WSAEINVAL, WSASYSNOTREADY, WSAVERNOTSUPPORTED: result := false; 
       else  Winsock.WSACleanup; 
    end; 
end;

procedure Tfrm_Main.btn_SendClick(Sender: TObject);
var
  str: string;
  I: Integer;
  str3: string;

  fail, ok, error: Integer;
begin
  if not WinsockEnabled() then
  begin
    Application.MessageBox('本机winsocket无效', '警告', MB_OK + MB_ICONWARNING);
    Exit;
  end;
  if chk_Long.Checked then
  begin
    if not initWinSocket(f_GetIP(), StrToIntDef(Trim(edt_Port.Text), 80)) then Exit;
  end;
  stop := false;
  gg_Main.MaxValue := m_Infos.f_GetCount - 1;
  btn_Load.Enabled  := False;
  btn_Clear.Enabled := False;
  btn_Send.Enabled  := False;
  chk_Long.Enabled  := False;
  fail := 0;
  ok   := 0;
  error := 0;
  new := 0;
  old := 0;
  tm_Count.Enabled := True;
  for I := 0 to m_Infos.f_GetCount - 1 do
  begin
    if not chk_Long.Checked then
    begin
    if not initWinSocket(f_GetIP(), StrToIntDef(Trim(edt_Port.Text), 80)) then Exit;
    end;
    gg_Main.Progress := I;
    new := I;
    m_Infos.f_SetIndex(I, 1);
    if stop then Break;
    Application.ProcessMessages;
    if stop then Break;
    str3 := m_Infos.f_GetDate(I)^.r_String;
    str := Trim(str3) + #10;
    if Send(sockfd, pointer(str)^, Length(str), 0) = -1 then
    begin
      if stop then Break;
      m_Infos.f_SetIndex(I, 2);
      m_Infos.f_SetReslut(I, '-1&999&socket error!');
      Inc(fail);
    end else
    begin
      if stop then Break;
      recv(sockfd, str2, SizeOf(str2), 0);
      if stop then Break;

      if copy(str2,0,1)='0' then
      begin
        m_Infos.f_SetIndex(I, 3);
        Inc(ok);
      end else
      begin
        m_Infos.f_SetIndex(I, 4);
        Inc(error);
      end;
      m_Infos.f_SetReslut(I, str2);
      ZeroMemory(@str2, SizeOf(str2));
    end;
    stat_Main.Panels.Items[1].Text := IntToStr(I+1) + '/'+  IntToStr(m_Infos.f_GetCount) + '(' +
                                      FormatFloat('00.00', (I+1)*100/m_Infos.f_GetCount) + ')';
    stat_Main.Panels.Items[2].Text := IntToStr(fail) + '/'+  IntToStr(I+1)+ '(' +
                                      FormatFloat('00.00', (fail)*100/(I+1)) + ')';
    stat_Main.Panels.Items[3].Text := IntToStr(ok) + '/'+ IntToStr(I+1)+ '(' +
                                      FormatFloat('00.00', (ok)*100/(I+1)) + ')';
    stat_Main.Panels.Items[4].Text := IntToStr(error) + '/' + IntToStr(I+1)+ '(' +
                                      FormatFloat('00.00', (error)*100/(I+1)) + ')';
    lv_Result.Repaint;

    if not chk_Long.Checked then
    begin
      CloseSocket(sockfd);
      shutdown(sockfd,2);
      WSAcleanup;
    end;
  end;
  new := 0;
  old := 0;
  tm_Count.Enabled := false;
  btn_Load.Enabled  := true;
  btn_Clear.Enabled := true;
  btn_Send.Enabled  := true;
  chk_Long.Enabled  := true;
  if chk_Long.Checked then
  begin
    CloseSocket(sockfd);
    shutdown(sockfd,2);
    WSAcleanup;
  end;
end;

procedure Tfrm_Main.btn_TestClick(Sender: TObject);
var
  ip: Integer;
  ip_str: string;
  ip_str_tmp1: string;
  ip_str_tmp2: string;
  ip_str_tmp3: string;
  ip_str_tmp4: string;
begin
 if initWinSocket(f_GetIP(), StrToIntDef(Trim(edt_Port.Text), 80)) then
 begin
   CloseSocket(sockfd);
   shutdown(sockfd,2);
   WSAcleanup;
   Application.MessageBox('Socket连接成功！', '提示',
                           MB_OK + MB_ICONINFORMATION);
   SendMessage(v_IPEdit.Handle,IPM_GETADDRESS, 0, Integer(@ip));
   m_Set.WriteInteger('SYSTEM','HOST1',First_IPAddress(ip));
   m_Set.WriteInteger('SYSTEM','HOST2',Second_IPAddress(ip));
   m_Set.WriteInteger('SYSTEM','HOST3',Third_IPAddress(ip));
   m_Set.WriteInteger('SYSTEM','HOST4',Fourth_IPAddress(ip));
   m_Set.WriteString('SYSTEM','PORT', edt_Port.Text);

   if not TryStrToInt(ip_str_tmp1, First_IPAddress(ip)) then
   begin
     ip_str_tmp1 := '0';
   end;
   if not TryStrToInt(ip_str_tmp2, Second_IPAddress(ip)) then
   begin
     ip_str_tmp2 := '0';
   end;
   if not TryStrToInt(ip_str_tmp3, Third_IPAddress(ip)) then
   begin
     ip_str_tmp3:= '0';
   end;
   if not TryStrToInt(ip_str_tmp4, Fourth_IPAddress(ip)) then
   begin
     ip_str_tmp4:= '0';
   end;
 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;
begin
  v_Frm := Tfrm_AddConf.Create(Application);
  try
    v_Frm.ShowModal;
  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.