nmnntp.pas

DELPHI里面一些常用的控件

procedure TNMNNTP.Disconnect;
var
   ReplyMess: string;
begin
   if FTransactionInProgress then cancel;
   if Connected then
      try
         ReplyMess := Transaction(Cons_QuitCmd);
      finally
         inherited Disconnect;
      end; {_ try _}
end; {_ procedure TNMNNTP.Disconnect; _}

procedure TNMNNTP.Abort;
begin
   Cancel;
   if (not BeenCanceled) and Connected then
   begin
      if FTransactionInProgress then
      begin
         Cancel;
      end {_ if FTransactionInProgress then _}
      else {_ NOT if FTransactionInProgress then _}
      begin
         inherited Disconnect;
         //TMemoryStream(FIstream).clear;
      end; {_ NOT if FTransactionInProgress then _}
   end; {_ if (not BeenCanceled) and Connected then _}
end; {_ procedure TNMNNTP.Abort; _}

procedure TNMNNTP.AbortResume(Sender: TObject);
begin
   inherited DisConnect;
   //TMemoryStream(FIstream).clear;
end; {_ procedure TNMNNTP.AbortResume(Sender: TObject); _}

procedure TNMNNTP.SetAttachmentPath(Path: string);
begin
   if Path[length(Path)] <> '\' then FAttachmentPath := Path + '\'
   else {_ NOT if Path[length(Path)] <> '\' then FAttachmentPath := Path + '\' _} FAttachmentPath := Path;
end; {_ procedure TNMNNTP.SetAttachmentPath(Path: string); _}


procedure TNMNNTP.SetNewsDir(Dir: string);
begin
   if Dir[length(Dir)] <> '\' then
      FNewsDir := Dir + '\'
   else {_ NOT if Dir[length(Dir)] <> '\' then _}
      FNewsDir := Dir;
end; {_ procedure TNMNNTP.SetNewsDir(Dir: string); _}

procedure TNMNNTP.SetGroup(Group: string);
var
   ReplyMess: string; 
   Done     : boolean;
begin
   Done := FALSE;
   if FTransactionInProgress then Exit;
   try
      FTransactionInProgress := TRUE;
      if (CacheMode <> cmLocal) then
      begin
         CertifyConnect;
         ReplyMess := Transaction(Cons_GrpCmd + Group);
         if ReplyNumber > 299 then raise NNTPError.create(sNNTP_Cons_InvGrpErr)
         else {_ NOT if ReplyNumber > 299 then raise NNTPError.create(Cons_InvGrpErr) _} FSelectedGroup := Group;
      end; {_ if (CacheMode <> cmLocal) then _}
      FLoMessage := StrToIntDef(NthWord(ReplyMess, ' ', 3), 0);
      FHiMessage := StrToIntDef(NthWord(ReplyMess, ' ', 4), 0);
      Done := TRUE;
   finally
      FTransactionInProgress := FALSE;
      if done and assigned(OnGroupSelect) then FOnGroupSelect(self);
   end; {_ try _}
end; {_ procedure TNMNNTP.SetGroup(Group: string); _}

procedure TNMNNTP.PostArticle;
var
   ReplyMess: string; 
   Done     : boolean;
   i:integer;
   UUPROC: TNMUUProcessor;
   SFileA: TmemoryStream;
   SfileF : TFileStream;
begin
   Done := FALSE;
   if FTransactionInProgress then Exit;
   try
      FTransactionInProgress := TRUE;
      CertifyConnect;
      ReplyMess := Transaction(Cons_GrpPost);
      write (FpostHeader.text + CRLF + CRLF);
      write (FpostBody.text);
      if FPostAttachments.count>0 then
      begin
         uuproc := TNMUUProcessor.create(self);
         SFileA:=TmemoryStream.create;
         uuproc.method := uuCode;
         uuproc.OutPutStream := SFileA;
         for i:=1 to FPostAttachments.count do
         begin
            SFileA.clear;
            writeln('' + CRLF );
            writeln('begin 666 '+ExtractFileName(FPostAttachments[i-1]));
            //if assigned(OnEncodeStart) then OnEncodeStart(FPostMessage.FAttachments[i - 1]);
            SfileF := TFileStream.create(FPostAttachments[i - 1], fmOpenRead);
            try

               uuproc.InPutStream := SfileF;
               uuproc.encode;
               Sendstream(SfileA);
            except
               on E: EFOpenError do
                 begin
                    //if assigned(OnAttachmentNotFound) then OnAttachmentNotFound(FPostMessage.FAttachments[i - 1]);
                    //raise;
                end; {_ SendAttachments(i); _}
            end; {_ try _}
            SfileF.free;
            //if assigned(OnEncodeEnd) then OnEncodeEnd(FPostMessage.FAttachments[i - 1]);
            writeln('end');
            writeln('' +CRLF);
         end;
         uuproc.free;
         SFileA.free;
      end;
      ReplyMess := Transaction('.');
      if ReplyNumber > 299 then
      begin
         raise NNTPError.create(sNNTP_Cons_PostingErr);
      end {_ if ReplyNumber > 299 then _}
      else {_ NOT if ReplyNumber > 299 then _} Done := TRUE;
   finally
      FTransactionInProgress := FALSE;
      if Done then
   begin if assigned(OnPosted) then OnPosted(self) end
else {_ NOT procedure TNMNNTP.PostArticle; _}
   if assigned(OnPostFailed) then
      OnPostFailed(self, ReplyNumber, TransactionReply);
end; {_ NOT procedure TNMNNTP.PostArticle; _}
end; {_ NOT procedure TNMNNTP.PostArticle; _}



procedure TNMNNTP.GetArticle(Ref: integer);
begin
   RetreiveArticle(3, Ref);
end; {_ procedure TNMNNTP.GetArticle(Ref: integer); _}


procedure TNMNNTP.GetArticleList(All: boolean; ArticleNumber: integer);
begin
   if All or (ArticleNumber < LoMessage) then RetreiveList(2, LoMessage)
   else {_ NOT if All or (ArticleNumber < LoMessage) then RetreiveList(2, LoMessage) _} RetreiveList(2, ArticleNumber);
end; {_ procedure TNMNNTP.GetArticleList(All: boolean; ArticleNumber: integer); _}

procedure TNMNNTP.GetGroupList;
   
begin
   RetreiveList(1, 0);
end; {_ procedure TNMNNTP.GetGroupList; _}

procedure TNMNNTP.GetArticleHeader(Ref: integer);
   
begin
   RetreiveArticle(1, Ref);
end; {_ procedure TNMNNTP.GetArticleHeader(Ref: integer); _}



function TNMNNTP.Transaction(const CommandString: string): string;
var GroupSelected: boolean;
   handled: boolean;

         Procedure AuthFail;
         begin
            if assigned(FOnAuthenticationFailed) then FOnAuthenticationFailed(self);
            raise NNTPError.Create(Cons_Msg_Auth_Fail);
         end;
begin
   BeenCanceled:=False;
   GroupSelected := FALSE;
   while not GroupSelected do
   begin
      GroupSelected := TRUE;
      Result := inherited Transaction(CommandString);
      if ReplyNumber = 480 then
      begin
         if ((FUserID = '') or (FPassword = '')) then
         begin
            Handled := FALSE;
            if assigned(FOnAuthenticationNeeded) then FOnAuthenticationNeeded(Handled);
            if not Handled then AuthFail;
         end; {_ if ((FUserID = '') or (FPassword = '')) then _}
        Result :=inherited Transaction('AUTHINFO USER '+UserID);
        if ReplyNumber=381 then inherited Transaction('AUTHINFO PASS '+Password);
        if ReplyNumber=502 then AuthFail;
        Result := inherited Transaction(CommandString);
        if ReplyNumber=502 then AuthFail;
      end;
      if ReplyNumber = 412 then
      begin
         GroupSelected := FALSE;
         if (SelectedGroup = '') and not assigned(FOnGroupSelectRequired) then raise Exception.create(sNNTP_Cons_GrpErr);
         handled := FALSE;
         if assigned(FOnGroupSelectRequired) then FOnGroupSelectRequired(handled);
         if not handled and (SelectedGroup = '') then raise Exception.create(sNNTP_Cons_GrpErr);
         FTransactionInProgress := FALSE;
         SetGroup(SelectedGroup);
         FTransactionInProgress := TRUE;
      end; {_ if ReplyNumber = 412 then _}
   end; {_ while not GroupSelected do _}
end; {_ function TNMNNTP.Transaction(const CommandString: string): string; _}


procedure TNMNNTP.GetArticleBody(Ref: integer);
   
begin
   RetreiveArticle(2, Ref);
end; {_ procedure TNMNNTP.GetArticleBody(Ref: integer); _}


procedure TNMNNTP.InternalConnect;
var
   ReplyMess: string; 
   handled  : boolean;
begin
   inherited Connect;
   try
      ReplyMess :=  Readln;
      if (ReplyNumber >= 400) and (ReplyNumber <> 480) then EsockError.create(sNNTP_Cons_LogInSerErr);
      if ((ReplyNumber < 400) and (ReplyNumber > 300)) or (ReplyNumber = 480) then
      begin
         if ((FUserID = '') or (FPassword = '')) then
         begin
            Handled := FALSE;
            if assigned(FOnAuthenticationNeeded) then FOnAuthenticationNeeded(Handled);
            if not Handled then raise NNTPError.Create(Cons_Msg_Auth_Fail);
         end; {_ if ((FUserID = '') or (FPassword = '')) then _}
         ReplyMess := Transaction(Cons_USerCmd + FUserID);
         if (ReplyNumber >= 400) and (ReplyNumber <> 480) then EsockError.create(sNNTP_Cons_LogInSerErr);
         if ((ReplyNumber < 400) and (ReplyNumber > 300)) or (ReplyNumber = 480) then
            ReplyMess := Transaction(Cons_PassCmd + FPassword);
         if ReplyNumber > 299 then
         begin
            if assigned(FOnAuthenticationFailed) then FOnAuthenticationFailed(self);
            raise NNTPError.Create(Cons_Msg_Auth_Fail);
         end; {_ if ReplyNumber > 299 then _}
      end; {_ if ((ReplyNumber < 400) and (ReplyNumber > 300)) or (ReplyNumber = 480) then _}
   except
      Disconnect;
      raise;
   end; {_ try _}
end; {_ procedure TNMNNTP.InternalConnect; _}


procedure TNMNNTP.RetreiveArticle(HBMode: integer; Ref: integer);
   
   function IsInCache(HBMode, I: integer): boolean;
      
   begin
      result := False;
   end; {_ function IsInCache(HBMode, I: integer): boolean; _}
   
var LCM: integer;
   Done, result: boolean;
   
begin
   Done := FALSE;
   Result := FALSE;
   LCM := 1;
   if FTransactionInProgress then Exit;
   try
      FTransactionInProgress := TRUE;
      CertifyConnect;
      if (CacheMode <> cmMixed) and IsInCache(HBMode, ref) then LCM := 1
      else {_ NOT if (CacheMode <> cmMixed) and IsInCache(HBMode, ref) then LCM := 1 _} LCM := 3;
      case LCM of
         1:
         begin
            if (HBMode and $1) <> 0 then Readfromcache(FHeader, Ref);
            if (HBMode and $2) <> 0 then Readfromcache(FBody, Ref);
         end; {_ 1: _}
         3:
         begin
            case HBMode of
               1:
               begin
                  Result := ReadTillDot(FHeader, 'HEAD ' + IntToStr(Ref));
                  FHeader.values['ArtId'] := IntToStr(Ref);
                  Done := TRUE;
               end; {_ 1: _}
               2:
               begin
 //                 FBytesTotal:=StrToIntdef(FHeader.values['Lines'],0);
                  Result := ReadTillDot(FBody, 'BODY' + IntToStr(Ref));
                  Done := TRUE;
               end; {_ 2: _}
               3:
               begin
                  ReadTillBlankLine(Ref);
                  FBytesTotal:=StrToIntdef(FHeader.values['Lines'],0);
                  Result := ReadTillDot(FBody, '');
                  if FParseAttachments then
                     ExtractAttachments;
                  FHeader.values['ArtId'] := IntToStr(Ref);
                  Done := TRUE;
               end; {_ 3: _}
            end; {_ case HBMode of _}
            if not Result then raise NNTPError.create(sNNTP_Cons_RetrErr);
         end; {_ 3: _}
         
      end; {_ case LCM of _}
      FCurrentArticle := Ref;
   finally
      FTransactionInProgress := FALSE;