u_mainfrm.pas

使用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);

   ip_str_tmp1 := IntToStr(First_IPAddress(ip));
   ip_str_tmp2 := IntToStr(Second_IPAddress(ip));