nmnntp.pas

DELPHI里面一些常用的控件

      if Done then
         case HBMode of
            1: if assigned(FOnHeader) then FOnHeader(Self);
            2: if assigned(FOnBody) then FOnBody(Self);
            3: if assigned(FOnArticle) then FOnArticle(Self);
         end; {_ case LCM of _}
   end; {_ try _}
end; {_ procedure TNMNNTP.RetreiveArticle(HBMode: integer; Ref: integer); _}

procedure TNMNNTP.RetreiveList(AGMode: integer; Ref: integer);
var
   i, j, k   : integer;
   AStr, Bstr: string; 
begin
   if FTransactionInProgress then Exit;
   try
      FTransactionInProgress := TRUE;
      case AGmode of
         1: if cacheMode <> cmLocal then
         begin
            CertifyConnect;
            FTransType := Trans_List;
            ReadTillDot(FGroupList, 'LIST');
            FTransType := Trans_None;
         end; {_ 1: if cacheMode <> cmLocal then _}
         2:
         begin
            if cacheMode <> cmLocal then
            begin
               CertifyConnect;
               if (ReadTillDot(FArticleList, 'XOVER ' + IntToStr(Ref) + '-' + IntToStr(HiMessage))) then
                  for i := 1 to FArticleList.count - 1 do
                  begin
                     FHeader.clear;
                     BStr := FArticleList[i - 1];
                     j := POS(#13, BStr);
                     if j > 0 then BStr[j] := #0;
                     k := 0;
                     repeat
                        j := Pos(#9, BStr);
                        if j > 0 then
                        begin
                           Astr := COPY(BStr, j + 1, 255);
                           SetLength(BStr,j-1);
                        end; {_ if j > 0 then _}
                         FHeader.add(Stable[k] + BStr);
                        Bstr := AStr;
                        inc(k);
                     until (j = 0) or (k=9);
                     if assigned(FOnHeaderList) then FOnHeaderList(self);
                  end {_ for i := 1 to FArticleList.count - 1 do _}
               else {_ NOT if (ReadTillDot(FArticleList, 'XOVER ' + IntToStr(Ref) + '-' + IntToStr(HiMessage))) then _}
                  for i := ref to HiMessage do
                  begin
                     ReadTillDot(FHeader, 'HEAD ' + IntToStr(i));
                     if assigned(FOnHeaderList) then FOnHeaderList(self);
                  end; {_ for i := ref to HiMessage do _}
            end; {_ if cacheMode <> cmLocal then _}
         end; {_ 2: _}
      end; {_ case AGmode of _}
   finally
      FTransactionInProgress := FALSE;
   end; {_ try _}
end; {_ procedure TNMNNTP.RetreiveList(AGMode: integer; Ref: integer); _}

function TNMNNTP.ReadTillDot(DestinationList: TStringList; Command: string): boolean;
var
   ReplyMess: string;
begin
   result := TRUE;
   FBytesRecvd := 0;
   DestinationList.clear;
   if Command <> '' then ReplyMess := Transaction(Command);
   if ReplyNumber > 299 then result := FALSE
   else {_ NOT if ReplyNumber > 299 then result := FALSE _}
      repeat
         ReplyMess := ReadLn;
         inc(FBytesRecvd);
         if assigned(OnPacketRecvd) then OnPacketRecvd(self);
         SetLength(ReplyMess, Length(ReplyMess) - 2);
         DestinationList.Add(ReplyMess);
         if ReplyMess <> '.' then
            if FtransType = Trans_List then
               if assigned(OnGroupListUpdate) then
                  OnGroupListUpdate(NthWord(ReplyMess, ' ', 1), StrToInt(NthWord(ReplyMess, ' ', 2)), StrToInt(NthWord(ReplyMess, ' ', 3)), NthWord(ReplyMess, ' ', 4) = 'F');
     until (ReplyMess = '.');
end; {_ function TNMNNTP.ReadTillDot(DestinationList: TStringList; Command: string): boolean; _}





procedure TNMNNTP.ReadTillBlankLine(Ref: integer);
var
   ReplyMess: string;
begin
   FHeader.Clear;
   ReplyMess := Transaction('ARTICLE ' + IntToStr(Ref));
   if ReplyNumber < 299 then
      repeat
         ReplyMess := ReadLn;
         SetLength(ReplyMess, Length(ReplyMess) - 2);
         FHeader.Add(ReplyMess);
      until (ReplyMess = '')
   else {_ NOT if ReplyNumber < 299 then _}
      begin
        if ReplyNumber=423 then
           FOnInvalidArticle(self);
        raise Exception.create(sNNTP_Cons_ArtErr);
      end;
end; {_ procedure TNMNNTP.ReadTillBlankLine(Ref: integer); _}


procedure TNMNNTP.Readfromcache(DestinationList: TStringList; ArticleNo: integer);
begin
end; {_ procedure TNMNNTP.Readfromcache(DestinationList: TStringList; ArticleNo: integer); _}

procedure TNMNNTP.ExtractAttachments;
var
   AStr: string;
begin
   AStr := FHeader.values['Content-Type'];
   if Astr = '' then ExtractEmbedded
   else {_ NOT if Astr = '' then ExtractEmbedded _}
      if (Pos('multipart', Lowercase(AStr)) <> 0) then
      begin
         FBoundary := Copy(AStr, Pos('dary=', AStr) + 7, 256);
         if FBoundary[1] = #22 then
            SetLength(FBoundary, Length(FBoundary) - 2)
         else {_ NOT if FBoundary[1] = #22 then _}
         begin
            SetLength(FBoundary, Length(FBoundary) - 3);
            FBoundary := Copy(FBoundary, 2, 255);
         end; {_ NOT if FBoundary[1] = #22 then _}
         ExtractMultipart;
      end {_ if (Pos('multipart', Uppercase(AStr)) <> 0) then _}
      else {_ NOT if (Pos('multipart', Uppercase(AStr)) <> 0) then _} ExtractEmbedded;
end; {_ procedure TNMNNTP.ExtractAttachments; _}

procedure TNMNNTP.ExtractEmbedded;
var i: integer;
   Pmode              : boolean;    
   TFilename          : string;     
   TempBody           :TStringStream;
   FinalBody: TstringList;
begin
   Pmode := FALSE;
   TempBody := TStringStream.create('');
   FinalBody := TStringList.create;
   try
      i := -1;
      repeat
         inc(i);
         if ((length(Body[i]) = 61) and (Pos(' ', Body[i]) = 0)) or (Pos('begin 644', Body[i]) > 0) or (Pos('begin 666', Body[i]) > 0) then
         begin
            if (Pos('begin 644', Body[i]) > 0) or (Pos('begin 666', Body[i]) > 0) then
            begin
               Pmode := TRUE;
               TFilename := NthWord(Body[i], ' ', 3);
               inc(i);     //Added KNA 6-24-98
            end {_ if Pos('begin 644', Body[i]) > 0 then _}
            else {_ NOT if Pos('begin 644', Body[i]) > 0 then _} TFilename := 'extract.dat';
            {$IFDEF NMF3} TempBody.Size:=0{$ELSE} TempBody.SetSize(0){$ENDIF};
            repeat
               TempBody.WriteString(Body[i]);
               inc(i);
            until ((not Pmode) and (length(Body[i]) <> 61)) or (PMode and (Pos('end', Body[i]) > 0));
            if assigned(FOnDecodeStart) then
                FOnDecodeStart(TFilename);
            Decode(TempBody, TFilename);
            if assigned(FOnDecodeEnd) then
                FOnDecodeEnd(self);
            Attachments.Add(TFileName);
            FinalBody.add(#13#10 + sNNTP_Cons_FileMsg1 + FAttachmentPath + TFileName + sNNTP_Cons_FileMsg2);
         end {_ if ((length(Body[i]) = 61) and (Pos(' ', Body[i]) = 0)) or (Pos('begin 644', Body[i]) > 0) then _}
         else {_ NOT if ((length(Body[i]) = 61) and (Pos(' ', Body[i]) = 0)) or (Pos('begin 644', Body[i]) > 0) then _} FinalBody.add(Body[i]);
      until Body[i] = '.';
      Body.assign(FinalBody);
   finally
      TempBody.free;
      FinalBody.free;
   end; {_ try _}
end; {_ procedure TNMNNTP.ExtractEmbedded; _}

procedure TNMNNTP.ExtractMultipart;
var i: integer;
   TempHead : TExStringList;
   Tempbody : TStringStream;
   FinalBody          : TExStringList;
   ReplyMess          : string;       
   TFileName, Ct1, Ct2: string;       
begin
   i := 0;
   TempHead := TExStringList.create;
   TempBody := TStringStream.create('');
   FinalBody := TExStringList.create;
   try
      while Pos(FBoundary, FBody[i]) = 0 do inc(i);
      repeat
         TempHead.clear;
         {$IFDEF NMF3} TempBody.Size:=0{$ELSE} TempBody.SetSize(0){$ENDIF};
         repeat
            inc(i);
            Temphead.add(FBody[i]);
         until FBody[i] = '';
         repeat
            inc(i);
            TempBody.WriteString(FBody[i]);
         until Pos(FBoundary, FBody[i]) > 0;
         Ct1 := Temphead.values['Content-Type:'];
         Ct2 := Temphead.values['Content-Transfer-Encoding'];
         if Pos('text', Ct1) > 0 then FinalBody.add(TempBody.DataString)
         else {_ NOT if Pos('text', Ct1) > 0 then FinalBody.add(TempBody.text) _}
         begin
            if Pos('name', Ct1) > 0 then TFileName := NthWord(ReplyMess, '"', 2)
            else {_ NOT if Pos('name', Ct1) > 0 then TFileName := NthWord(ReplyMess, '"', 2) _} TFileName := 'Extract.dat';
            if (Pos('base64', Ct2) > 0) or (Pos('Base64', Ct2) > 0) or (Pos('X-UUENCODE', Ct2) > 0) then
               Decode(TempBody, TFileName)
            else {_ NOT if (Pos('base64', Ct2) > 0) or (Pos('Base64', Ct2) > 0) or (Pos('X-UUENCODE', Ct2) > 0) then _} {TempBody.SaveToFile(TFileName)};
            Attachments.Add(TFileName);
            FinalBody.add(#13#10 + sNNTP_Cons_FileMsg1 + FAttachmentPath + TFileName + sNNTP_Cons_FileMsg2);
         end; {_ NOT if Pos('text', Ct1) > 0 then FinalBody.add(TempBody.text) _}
      until Pos(FBoundary + '--', FBody[i]) > 0;
      while FBody[i] <> '.' do inc(i);
      FBody.assign(Finalbody);
   finally
      TempHead.free;
      TempBody.free;
      FinalBody.free;
   end; {_ try _}
end; {_ procedure TNMNNTP.ExtractMultipart; _}

procedure TNMNNTP.Decode(AStream: TStream; var TFileName: string);
var i: integer;
   Tempcode        : TFileStream;   
   uuproc          : TNMUUProcessor;
   TFname1, TFname2: string;        
begin
   TFname1 := NthWord(TFileName, '.', 1);
   TFname2 := NthWord(TFileName, '.', 2);
   i := 1;
   while FileExists(FAttachmentPath + TFileName) do
   begin
      TFileName := TFName1 + '_' + IntToStr(i) + '.' + TFName2;
      i := i + 1;
   end; {_ while FileExists(FAttachmentPath + TFileName) do _}
   Tempcode := TFileStream.create(FAttachmentPath + TFileName, fmCreate);
   try
      uuproc := TNMUUProcessor.create(self);
      uuproc.method := uucode;
//      uuproc.method := uumime;  
      uuproc.OutputStream := Tempcode;
      uuproc.InPutStream := AStream;
      AStream.position := 0;
      uuproc.decode;
      uuproc.free;
   finally
      Tempcode.free;
   end; {_ try _}
end; {_ procedure TNMNNTP.Decode(AStringList: TStringList; var TFileName: string); _}

procedure TNMNNTP.SetPostAttachments(Value: TStringList);
begin
   FPostAttachments.assign(value);
end; {_ procedure TNMNNTP.SetPostAttachments(Value: TStringList); _}

procedure TNMNNTP.SetPostBody(Value: TExStringList);
begin
   FPostBody.assign(value);
end; {_ procedure TNMNNTP.SetPostBody(Value: TExStringList); _}

procedure TNMNNTP.SetPostHeader(Value: TExStringList);
begin
   FPostHeader.assign(value);
end; {_ procedure TNMNNTP.SetPostHeader(Value: TExStringList); _}

function TPostRecordType.GetPrLineCount;
begin result := StrToInt(FPostHeader.values['Lines']) end;
function TPostRecordType.GetPrByteCount;
begin result := StrToInt(FPostHeader.values['Bytecount']) end;
function TPostRecordType.GetPrFromAddress;
begin result := FPostHeader.values['From'] end;
procedure TPostRecordType.SetPrFromAddress;
begin FPostHeader.values['From'] := index end;
function TPostRecordType.GetPrReplyTo;
begin result := FPostHeader.values['ReplyTo'] end;
procedure TPostRecordType.SetPrReplyTo;
begin FPostHeader.values['ReplyTo'] := index end;
function TPostRecordType.GetPrSubject;
begin result := FPostHeader.values['Subject'] end;
procedure TPostRecordType.SetPrSubject;
begin FPostHeader.values['Subject'] := index end;
function TPostRecordType.GetPrDistribution;
begin result := FPostHeader.values['Distribution'] end;
procedure TPostRecordType.SetPrDistribution;
begin FPostHeader.values['Distribution'] := index end;
function TPostRecordType.GetPrAppName;
begin result := FPostHeader.values['X-Newsreader'] end;
procedure TPostRecordType.SetPrAppName;
begin FPostHeader.values['X-Newsreader'] := index end;
function TPostRecordType.GetPrTimeDate;
begin result := FPostHeader.values['Date'] end;
procedure TPostRecordType.SetPrTimeDate;
begin FPostHeader.values['Date'] := index end;
function TPostRecordType.GetNewsGroups;
begin result := FPostHeader.values['Newsgroups'] end;
procedure TPostRecordType.SetNewsGroups;
begin FPostHeader.values['Newsgroups'] := index end;
function TPostRecordType.GetArticleID;
begin
   result := StrToIntDef(FPostHeader.values['ArtID'], 0);
end; {_ function TPostRecordType.GetArticleID; _}
end.