sender1.pas

文件名称：新曦 我的资源 搜索软件 源程序(Borland Delphi 7)说明

    { Check which method use to send more data }
    { Using OnDataSent event will prevent internal TWSocket buffer to be }
    { enlarged without limit.                                            }
    FUseDataSent := UseDataSentCheckBox.Checked;
    if FUseDataSent then
        WSocket1.OnDataSent := WSocket1DataSent
    else
        WSocket1.OnDataSent := WSocket1NoDataSent;

    { Prepare data to be sent }
    Buf := '0000 ' + DataEdit.Text;
    Len := StrToInt(Trim(LengthEdit.Text));
    if Len <= 0 then
        Len := Length(Buf);
    if FDataBuf <> nil then
        Freemem(FDataBuf, FDataBufSize);
    FDataBufSize := Len + 3;
    GetMem(FDataBuf, FDataBufSize);
    if Len > 0 then begin
        if Len < Length(Buf) then
            Move(Buf[1], FDataBuf[0], Len)
        else begin
            T := 0;
            while T < Len do begin
                N := Length(Buf);
                if (T + N) > Len then
                    N := Len - T;
                if N > 0 then
                    Move(Buf[1], FDataBuf[T], N);
                T := T + N;
            end;
        end;
    end;
    FDataBuf[Len]     := #13;
    FDataBuf[Len + 1] := #10;
    FDataBuf[Len + 2] := #0;

    { Launch DNS lookup. When done, we'll try to connect. }
    WSocket1.DnsLookup(Trim(ServerEdit.Text));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ We comes here when DNS lookup is finished, even in case of failure.       }
procedure TSenderForm.WSocket1DnsLookupDone(Sender: TObject; Error: Word);
begin
    { If any error occured, we just display info and prepare to restart. }
    if Error <> 0 then begin
        MessageBeep(MB_OK);
        Display('DNS failure. Error #' + IntToStr(Error));
        ActionButton.Caption := '&Start';
        PauseButton.Visible  := FALSE;
        Exit;
    end;

    { Now we know the IP address. Try to connect. }
    WSocket1.Addr  := WSocket1.DnsResult;
    WSocket1.Port  := Trim(PortEdit.Text);
    WSocket1.Proto := 'tcp';
    try
        WSocket1.Connect;
    except
        on E:Exception do begin
            MessageBeep(MB_OK);
            Display('Connect failed: ' + E.Message);
            ActionButton.Caption := '&Start';
            PauseButton.Visible  := FALSE;
            FAutoStart           := 0;
            Exit;
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.WSocket1SessionConnected(Sender: TObject;
  Error: Word);
begin
    if Error <> 0 then begin
        MessageBeep(MB_OK);
        Display('Can''t connect. Error #' + IntToStr(Error));
        ActionButton.Caption := '&Start';
        FAutoStart           := 0;
        Exit;
    end;
    Display('Connected');
    if LingerCheckBox.Checked then
        WSocket1.LingerOnOff   := wsLingerOn
    else
        WSocket1.LingerOnOff   := wsLingerOff;
    WSocket1.LingerTimeout := 300;
    WSocket1.SetLingerOption;
    DoSend;
    if FUseDataSent then
        Exit;

    { User requested to not use OnDataSent event. We will simply loop.      }
    { until all data has been sent. This will fill TWSocket internal buffer }
    { very quickly while data is being sent in the background at network    }
    { speed.                                                                }
    while (FFinalCount <= 0) or (FFinalCount > FCount) do begin
        { We must break the loop if user temrinated the application,        }
        { or if connection is broke, or if user stopped.                    }
        if (Application.Terminated) or
           (WSocket1.State <> wsConnected) or
           (not FSending) then
            Exit;
        { Otherwise, we can send data }
        DoSend;
    end;
    CountLabel.Caption  := IntToStr(FCount);
    PauseButton.Visible := FALSE;
    Display('All data is in TWSocket buffer and being sent in the background');
    FFinished := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.DoSend;
var
    Buf : String;
begin
    repeat
        { Calling ProcessMessages let a chance to button and other events }
        { to be handled.                                                  }
        Application.ProcessMessages;
        { We must stop if the user clicked the close button. }
        if Application.Terminated then begin
            Display('Application terminated');
            Exit;
        end;
        { We must stop if the user requested to stop send }
        if not FSending then
            Exit;
        { We must stop if connection is broken }
        if WSocket1.State <> wsConnected then
            Exit;
        {$IFNDEF VER80}
        { We don't wants to use 100% CPU just looping. Sleep a little bit }
        if FPaused then
            Sleep(250);
        {$ENDIF}
    until FPaused = FALSE;

    { We need to check if we are still connected before sending }
    if WSocket1.State <> wsConnected then
        Exit;

    if (FFinalCount <= 0) or (FFinalCount > FCount) then begin
        { Count the message sent }
        Inc(FCount);
        { Put the counter into the message, truvated to 4 digits }
        Buf := IntToStr(FCount mod 10000) + '    ';
        Move(Buf[1], FDataBuf[0], 4);

        { If required, display in memo box (slow down !) }
        if FDisplayData then
            Display('Sending ' + IntToStr(FCount));
        { Display the counter every 100 sends }
        if (FCount mod 100) = 0 then
            CountLabel.Caption := IntToStr(FCount);

        { Try to send data. Send may fail ! }
        try
            WSocket1.Send(FDataBuf, FDataBufSize - 1);
        except
            on E:Exception do begin
                Display('Exception during TWSocket.Send: ' + E.Message);
                FAutoStart := 0;
                PostMessage(Handle, WM_CLOSE_REQUEST, 0, LParam(WSocket1));
            end;
        end;
    end
    else begin
        Display('Required data has been sent. Closing.');
        { We may have not read data send by server. But anyway, close the }
        { session.                                                        }
        PostMessage(Handle, WM_CLOSE_REQUEST, 0, LParam(WSocket1));
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.WSocket1DataSent(Sender: TObject; Error: Word);
begin
    DoSend;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.WSocket1NoDataSent(Sender: TObject; Error: Word);
begin
    if FFinished then begin
        if not WSocket1.AllSent then
            Display('Not all sent');
        Display('Required data has been sent. Closing.');
        PostMessage(Handle, WM_CLOSE_REQUEST, 0, LParam(WSocket1));
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.WSocket1DataAvailable(Sender: TObject; Error: Word);
var
    Buf : PChar;
    Cli : TWSocket;
    Len : Integer;
    Cnt : Integer;
begin
    Cli := Sender as TWSocket;
    Cnt := Cli.RcvdCount;
    if Cnt <= 0 then
        Exit;
{$IFDEF VER80}
    { Delphi 1 has 255 character limit of strings (StrPas below) }
    if Cnt > 254 then
        Cnt := 254;
{$ENDIF}
    GetMem(Buf, Cnt + 1);
    try
        Len := Cli.Receive(Buf, Cnt);
        if Len > 0 then begin
            Buf[Cnt] := #0;
            Display('Received: ' + StrPas(Buf));
        end;
    finally
        FreeMem(Buf, Cnt + 1);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.WSocket1SessionClosed(Sender: TObject; Error: Word);
begin
    if Error = 0 then
        Display('Socket closed, no error')
    else begin
        Display('Socket closed, Error #' + IntToStr(Error));
        FAutoStart := 0;
    end;
    FSending             := FALSE;
    ActionButton.Caption := '&Start';
    PauseButton.Visible  := FALSE;
    FPaused              := FALSE;
    if FAutoStart > 0 then begin
        Inc(FAutoStart);
        AutoStartButton.Caption := IntToStr(FAutoStart);
        PostMessage(Handle, WM_AUTO_START, 0, 0);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.DisplayDataCheckBoxClick(Sender: TObject);
begin
    FDisplayData := DisplayDataCheckBox.Checked;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.UseDataSentCheckBoxClick(Sender: TObject);
begin
    FUseDataSent := UseDataSentCheckBox.Checked;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.PauseButtonClick(Sender: TObject);
begin
    CountLabel.Caption := IntToStr(FCount);
    FPaused := not FPaused;
    if FPaused then
        PauseButton.Caption := '&Resume'
    else
        PauseButton.Caption := '&Pause';
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.AutoStartButtonClick(Sender: TObject);
begin
    if FAutoStart <> 0 then begin
        FAutoStart := 0;
        Exit;
    end;

    FAutoStart := 1;
    AutoStartButton.Caption := IntToStr(FAutoStart);
    PostMessage(Handle, WM_AUTO_START, 0, 0);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.WMCloseRequest(var msg: TMessage);
var
    WSocket : TWSocket;
begin
    WSocket := TWSocket(msg.LParam);
    WSocket.Close;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSenderForm.WMAutoStart(var msg: TMessage);
begin
    ActionButtonClick(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.