imapsend.pas

snmp设计增加相应SNMP的OID,是实时处理的.

  FSelectedCount := 0;
  FSelectedRecent := 0;
  FSelectedUIDvalidity := 0;
  for n := 0 to FFullResult.Count - 1 do
  begin
    s := uppercase(FFullResult[n]);
    if Pos(' EXISTS', s) > 0 then
    begin
      t := Trim(separateleft(s, ' EXISTS'));
      t := Trim(separateright(t, '* '));
      FSelectedCount := StrToIntDef(t, 0);
    end;
    if Pos(' RECENT', s) > 0 then
    begin
      t := Trim(separateleft(s, ' RECENT'));
      t := Trim(separateright(t, '* '));
      FSelectedRecent := StrToIntDef(t, 0);
    end;
    if Pos('UIDVALIDITY', s) > 0 then
    begin
      t := Trim(separateright(s, 'UIDVALIDITY '));
      t := Trim(separateleft(t, ']'));
      FSelectedUIDvalidity := StrToIntDef(t, 0);
    end;
  end;
end;

procedure TIMAPSend.ParseSearch(Value:TStrings);
var
  n: integer;
  s: string;
begin
  ProcessLiterals;
  Value.Clear;
  for n := 0 to FFullResult.Count - 1 do
  begin
    s := uppercase(FFullResult[n]);
    if Pos('* SEARCH', s) = 1 then
    begin
      s := Trim(SeparateRight(s, '* SEARCH'));
      while s <> '' do
        Value.Add(Fetch(s, ' '));
    end;
  end;
end;

function TIMAPSend.FindCap(const Value: string): string;
var
  n: Integer;
  s: string;
begin
  s := UpperCase(Value);
  Result := '';
  for n := 0 to FIMAPcap.Count - 1 do
    if Pos(s, UpperCase(FIMAPcap[n])) = 1 then
    begin
      Result := FIMAPcap[n];
      Break;
    end;
end;

function TIMAPSend.AuthLogin: Boolean;
begin
  Result := IMAPcommand('LOGIN "' + FUsername + '" "' + FPassword + '"') = 'OK';
end;

function TIMAPSend.Connect: Boolean;
begin
  FSock.CloseSocket;
  FSock.Bind(FIPInterface, cAnyPort);
{$IFDEF STREAMSEC}
  if FFullSSL then
  begin
    if assigned(FTLSServer) then
      FSock.TLSServer := FTLSServer
    else
    begin
      Result := false;
      exit;
    end;
  end
  else
    FSock.TLSServer := nil;
{$ELSE}
  if FFullSSL then
    FSock.SSLEnabled := True;
{$ENDIF}
  if FSock.LastError = 0 then
    FSock.Connect(FTargetHost, FTargetPort);
  Result := FSock.LastError = 0;
end;

function TIMAPSend.Capability: Boolean;
var
  n: Integer;
  s, t: string;
begin
  Result := False;
  FIMAPcap.Clear;
  s := IMAPcommand('CAPABILITY');
  if s = 'OK' then
  begin
    ProcessLiterals;
    for n := 0 to FFullResult.Count - 1 do
      if Pos('* CAPABILITY ', FFullResult[n]) = 1 then
      begin
        s := Trim(SeparateRight(FFullResult[n], '* CAPABILITY '));
        while not (s = '') do
        begin
          t := Trim(separateleft(s, ' '));
          s := Trim(separateright(s, ' '));
          if s = t then
            s := '';
          FIMAPcap.Add(t);
        end;
      end;
    Result := True;
  end;
end;

function TIMAPSend.Login: Boolean;
var
  s: string;
begin
  FSelectedFolder := '';
  FSelectedCount := 0;
  FSelectedRecent := 0;
  FSelectedUIDvalidity := 0;
  Result := False;
  FAuthDone := False;
  if not Connect then
    Exit;
  s := FSock.RecvString(FTimeout);
  if Pos('* PREAUTH', s) = 1 then
    FAuthDone := True
  else
    if Pos('* OK', s) = 1 then
      FAuthDone := False
    else
      Exit;
  if Capability then
  begin
    if Findcap('IMAP4rev1') = '' then
      Exit;
    if FAutoTLS and (Findcap('STARTTLS') <> '') then
      if StartTLS then
        Capability;
  end;
  Result := AuthLogin;
end;

function TIMAPSend.Logout: Boolean;
begin
  Result := IMAPcommand('LOGOUT') = 'OK';
  FSelectedFolder := '';
  FSock.CloseSocket;
end;

function TIMAPSend.NoOp: Boolean;
begin
  Result := IMAPcommand('NOOP') = 'OK';
end;

function TIMAPSend.List(FromFolder: string; const FolderList: TStrings): Boolean;
begin
  Result := IMAPcommand('LIST "' + FromFolder + '" *') = 'OK';
  ParseFolderList(FolderList);
end;

function TIMAPSend.ListSearch(FromFolder, Search: string; const FolderList: TStrings): Boolean;
begin
  Result := IMAPcommand('LIST "' + FromFolder + '" "' + Search +'"') = 'OK';
  ParseFolderList(FolderList);
end;

function TIMAPSend.ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean;
begin
  Result := IMAPcommand('LSUB "' + FromFolder + '" *') = 'OK';
  ParseFolderList(FolderList);
end;

function TIMAPSend.ListSearchSubscribed(FromFolder, Search: string; const FolderList: TStrings): Boolean;
begin
  Result := IMAPcommand('LSUB "' + FromFolder + '" "' + Search +'"') = 'OK';
  ParseFolderList(FolderList);
end;

function TIMAPSend.CreateFolder(FolderName: string): Boolean;
begin
  Result := IMAPcommand('CREATE "' + FolderName + '"') = 'OK';
end;

function TIMAPSend.DeleteFolder(FolderName: string): Boolean;
begin
  Result := IMAPcommand('DELETE "' + FolderName + '"') = 'OK';
end;

function TIMAPSend.RenameFolder(FolderName, NewFolderName: string): Boolean;
begin
  Result := IMAPcommand('RENAME "' + FolderName + '" "' + NewFolderName + '"') = 'OK';
end;

function TIMAPSend.SubscribeFolder(FolderName: string): Boolean;
begin
  Result := IMAPcommand('SUBSCRIBE "' + FolderName + '"') = 'OK';
end;

function TIMAPSend.UnsubscribeFolder(FolderName: string): Boolean;
begin
  Result := IMAPcommand('UNSUBSCRIBE "' + FolderName + '"') = 'OK';
end;

function TIMAPSend.SelectFolder(FolderName: string): Boolean;
begin
  Result := IMAPcommand('SELECT "' + FolderName + '"') = 'OK';
  FSelectedFolder := FolderName;
  ParseSelect;
end;

function TIMAPSend.SelectROFolder(FolderName: string): Boolean;
begin
  Result := IMAPcommand('EXAMINE "' + FolderName + '"') = 'OK';
  FSelectedFolder := FolderName;
  ParseSelect;
end;

function TIMAPSend.CloseFolder: Boolean;
begin
  Result := IMAPcommand('CLOSE') = 'OK';
  FSelectedFolder := '';
end;

function TIMAPSend.StatusFolder(FolderName, Value: string): integer;
var
  n: integer;
  s, t: string;
begin
  Result := -1;
  Value := Uppercase(Value);
  if IMAPcommand('STATUS "' + FolderName + '" (' + Value + ')' ) = 'OK' then
  begin
    ProcessLiterals;
    for n := 0 to FFullResult.Count - 1 do
    begin
      s := FFullResult[n];
//      s := UpperCase(FFullResult[n]);
      if (Pos('* ', s) = 1) and (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then
      begin
        t := SeparateRight(s, Value);
        t := SeparateLeft(t, ')');
        t := trim(t);
        Result := StrToIntDef(t, -1);
        Break;
      end;
    end;
  end;
end;

function TIMAPSend.ExpungeFolder: Boolean;
begin
  Result := IMAPcommand('EXPUNGE') = 'OK';
end;

function TIMAPSend.CheckFolder: Boolean;
begin
  Result := IMAPcommand('CHECK') = 'OK';
end;

function TIMAPSend.AppendMess(ToFolder: string; const Mess: TStrings): Boolean;
begin
  Result := IMAPuploadCommand('APPEND "' + ToFolder + '"', Mess) = 'OK';
end;

function TIMAPSend.DeleteMess(MessID: integer): boolean;
var
  s: string;
begin
  s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (\Deleted)';
  if FUID then
    s := 'UID ' + s;
  Result := IMAPcommand(s) = 'OK';
end;

function TIMAPSend.FetchMess(MessID: integer; const Mess: TStrings): Boolean;
var
  s: string;
begin
  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822)';
  if FUID then
    s := 'UID ' + s;
  Result := IMAPcommand(s) = 'OK';
  ParseMess(Mess);
end;

function TIMAPSend.FetchHeader(MessID: integer; const Headers: TStrings): Boolean;
var
  s: string;
begin
  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.HEADER)';
  if FUID then
    s := 'UID ' + s;
  Result := IMAPcommand(s) = 'OK';
  ParseMess(Headers);
end;

function TIMAPSend.MessageSize(MessID: integer): integer;
var
  n: integer;
  s, t: string;
begin
  Result := -1;
  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.SIZE)';
  if FUID then
    s := 'UID ' + s;
  if IMAPcommand(s) = 'OK' then
  begin
    ProcessLiterals;
    for n := 0 to FFullResult.Count - 1 do
    begin
      s := UpperCase(FFullResult[n]);
      if (Pos('* ', s) = 1) and (Pos('RFC822.SIZE', s) > 0 ) then
      begin
        t := SeparateRight(s, 'RFC822.SIZE ');
        t := Trim(SeparateLeft(t, ')'));
        Result := StrToIntDef(t, -1);
        Break;
      end;
    end;
  end;
end;

function TIMAPSend.CopyMess(MessID: integer; ToFolder: string): Boolean;
var
  s: string;
begin
  s := 'COPY ' + IntToStr(MessID) + ' "' + ToFolder + '"';
  if FUID then
    s := 'UID ' + s;
  Result := IMAPcommand(s) = 'OK';
end;

function TIMAPSend.SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
var
  s: string;
begin
  s := 'SEARCH ' + Criteria;
  if FUID then
    s := 'UID ' + s;
  Result := IMAPcommand(s) = 'OK';
  ParseSearch(FoundMess);
end;

function TIMAPSend.SetFlagsMess(MessID: integer; Flags: string): Boolean;
var
  s: string;
begin
  s := 'STORE ' + IntToStr(MessID) + ' FLAGS.SILENT (' + Flags + ')';
  if FUID then
    s := 'UID ' + s;
  Result := IMAPcommand(s) = 'OK';
end;

function TIMAPSend.AddFlagsMess(MessID: integer; Flags: string): Boolean;
var
  s: string;
begin
  s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (' + Flags + ')';
  if FUID then
    s := 'UID ' + s;
  Result := IMAPcommand(s) = 'OK';
end;

function TIMAPSend.DelFlagsMess(MessID: integer; Flags: string): Boolean;
var
  s: string;
begin
  s := 'STORE ' + IntToStr(MessID) + ' -FLAGS.SILENT (' + Flags + ')';
  if FUID then
    s := 'UID ' + s;
  Result := IMAPcommand(s) = 'OK';
end;

function TIMAPSend.GetFlagsMess(MessID: integer; var Flags: string): Boolean;
var
  s: string;
  n: integer;
begin
  Flags := '';
  s := 'FETCH ' + IntToStr(MessID) + ' (FLAGS)';
  if FUID then
    s := 'UID ' + s;
  Result := IMAPcommand(s) = 'OK';
  ProcessLiterals;
  for n := 0 to FFullResult.Count - 1 do
  begin
    s := uppercase(FFullResult[n]);
    if (Pos('* ', s) = 1) and (Pos('FLAGS', s) > 0 ) then
    begin
      s := SeparateRight(s, 'FLAGS');
      s := Separateright(s, '(');
      Flags := Trim(SeparateLeft(s, ')'));
    end;
  end;
end;

function TIMAPSend.StartTLS: Boolean;
begin
  Result := False;
  if FindCap('STARTTLS') <> '' then
  begin
    if IMAPcommand('STARTTLS') = 'OK' then
    begin
{$IFDEF STREAMSEC}
      if not assigned(FTLSServer) then
        Exit;
      Fsock.TLSServer := FTLSServer;
      FSock.Connect('','');
{$ELSE}
      Fsock.SSLDoConnect;
{$ENDIF}
      Result := FSock.LastError = 0;
    end;
  end;
end;

//Paul Buskermolen <[e-mail]>
function TIMAPSend.GetUID(MessID: integer; var UID : Integer): boolean;
var
  s, sUid: string;
  n: integer;
begin
  sUID := '';
  s := 'FETCH ' + IntToStr(MessID) + ' UID';
  Result := IMAPcommand(s) = 'OK';
  ProcessLiterals;
  for n := 0 to FFullResult.Count - 1 do
  begin
    s := uppercase(FFullResult[n]);
    if Pos('FETCH (UID', s) >= 1 then
    begin
      s := Separateright(s, '(UID ');
      sUID := Trim(SeparateLeft(s, ')'));
    end;
  end;
  UID := StrToIntDef(sUID, 0);
end;

{==============================================================================}

end.