⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 pop3.pas

📁 siMail, siMail, siMail, siMail
💻 PAS
📖 第 1 页 / 共 2 页
字号:
          FUidlList.Add(tmpUidl);
      end
      else //no
        FDoWhat := tdwGetAndDelete;
    end;

  end;

  Result := msgNo;
end;

function Tpop3Task.MessageNextCmd(msgNo: Integer; currCmd: String): String;
begin
  if (msgNo < 0) or (msgNo > Fpop3.StatCount) then begin
    Result := 'logout';
    exit;
  end;

  if currCmd = '' then begin
    if Assigned(OnStatus) then
      OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
    Result := 'list';
  end
  else if currCmd = 'list' then begin
    case FDoWhat of
      tdwGetAndLeave:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d ...'), [msgNo, Fpop3.StatCount]));
        Result := 'retr';
      end;
      tdwGetAndDelete:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d ...'), [msgNo, Fpop3.StatCount]));
        Result := 'retr';
      end;
      tdwDelete:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Deleting message %d of %d ...'), [msgNo, Fpop3.StatCount]));
        Result := 'dele';
      end;
      tdwIgnore:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwGetHeaders:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d headers ...'), [msgNo, Fpop3.StatCount]));
        Result := 'top';
      end;
    end;
  end
  else if currCmd = 'dele' then begin
    case FDoWhat of
      tdwGetAndLeave:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwGetAndDelete:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwDelete:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwIgnore:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwGetHeaders:
      begin
        raise EPop3StatemachineFailed.Create(
          Format(_('State machine failed on message no:%d and cmd:%s'), [msgNo, currCmd]));
      end;
    end;
  end
  else if currCmd = 'retr' then begin
    case FDoWhat of
      tdwGetAndLeave:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwGetAndDelete:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Deleting message %d of %d ...'), [msgNo, Fpop3.StatCount]));
        Result := 'dele';
      end;
      tdwDelete:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwIgnore:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwGetHeaders:
      begin
        raise EPop3StatemachineFailed.Create(
          Format(_('State machine failed on message no:%d and cmd:%s'), [msgNo, currCmd]));
      end;
    end;
  end
  else if currCmd = 'top' then begin
    case FDoWhat of
      tdwGetAndLeave:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwGetAndDelete:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwDelete:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwIgnore:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
      tdwGetHeaders:
      begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [msgNo, Fpop3.StatCount]));
        Result := 'list';
      end;
    end;
  end;

end;

procedure Tpop3Task.StartThread(const _cmd: String; msgNo: Integer);
begin
  FThread := Tpop3Thread.Create(Fpop3, FHandle);
  with FThread do begin
    Priority := tpLower;
    OnTerminate := OnPOP3ThreadDone;
    MessageNo := msgNo;
    Cmd := _cmd;
    Resume;
  end;
end;

function Tpop3Task.Uidl(msgNo: Integer): String;
begin
  Result := FServerUidlList.Strings[msgNo - 1];
end;

procedure Tpop3Thread.MessageHandler(var Msg: TMessage);
var tmp: Integer;
begin
    //update progress bar
  if Msg.Msg = WM_TIMER then begin
    Msg.Result := 1;
    if not FDoNotPost then begin
      tmp := Fpop3.Sock.RecvCounter;
      if msg.WParam = 0 then
        PostMessage(FHandle, WM_PROGRESS, tmp - FoldDownload, 0)
      else
        PostMessage(FHandle, WM_PROGRESS, Msg.WParam, 0);
      FoldDownload := tmp;
    end;

        //check if cancel was isued
    TaskCriticalCancel.Acquire;
    if Cancel then begin
      Fpop3.Timeout := 1;
      Fpop3.Sock.CloseSocket;
      Self.Terminate;
    end;
    TaskCriticalCancel.Release;
  end
end;

{ Tpop3Task }

procedure Tpop3Task.OnPOP3ThreadDone(Sender: TObject);
var i: Integer;
begin
        //display last messages
    CheckError(Fthread.Successful);
    if Fthread.Cancel then begin
      if Assigned(OnDone) then OnDone();
      Exit;
    end;
    if not Fthread.Successful then begin
            //clean up
      if Assigned(OnStatus) then OnStatus(_('Error. I''m cleaning up.'));
      Fthread.Terminate;
      Fthread.Resume;
      if Assigned(OnDone) then OnDone();
      Exit;
    end;
    if Fthread.Cmd = 'login' then begin
      if Assigned(OnStatus) then OnStatus(_('Getting mailbox info ...'));
      StartThread('stat', 0);
    end
    else if Fthread.Cmd = 'stat' then begin
      if Fpop3.StatCount = 0 then begin
        StartThread('logout', 0);
        Exit;
      end;
            //set total dl size
      if Assigned(OnProgress) then OnProgress(Fpop3.StatSize, tsdTotal);

      if Assigned(OnStatus) then OnStatus(_('Getting messages unique IDs ...'));
      StartThread('uidl', 0);

    end
    else if Fthread.Cmd = 'uidl' then begin
      FServerUidlList.Clear;
      for i := 0 to FPop3.FullResult.Count - 1 do begin
        FServerUidlList.Add(SeparateRight(FPop3.FullResult[i], ' '))
      end;
            //remove all uidls that don't exist on server from local list
      for i := FUidlList.Count - 1 downto 0 do begin
        if FServerUidlList.IndexOf(FUidlList.Uidl[i].uidl) = -1 then
          FUidlList.Delete(i);
      end;

      i := PrepareForNextMessage(0);
      if i >= 0 then begin
        if Assigned(OnStatus) then
          OnStatus(Format(_('Fetching message %d of %d info ...'), [i, Fpop3.StatCount]));
        StartThread('list', i);
      end
      else
        StartThread('logout', i);

    end
    else if Fthread.Cmd = 'list' then begin
      if Assigned(OnProgress) then OnProgress(Fpop3.ListSize, tsdMessage);
      if FDoWhat = tdwIgnore then begin //next msg only on tdwIgnore
        if Assigned(OnProgress) then OnProgress(Fpop3.ListSize, tsdUpdate);
        i := PrepareForNextMessage(FThread.MessageNo);
                //we have to list next message so set that we came from '' which
                //always lists next message
        if FDoWhat <> tdwIgnore then
          FThread.Cmd := '';
            //is msgSize > IncomingMaxMailSize ? and show only on larger
      end
      else if (FTask.taskType = ttFetch) and
        (TAccount(FTask.config).IncomingMaxMailSize <> 0) and
        ((TAccount(FTask.config).IncomingShowHeadersLarger)) then begin
        if ((FPop3.ListSize) >
          (TAccount(FTask.config).IncomingMaxMailSize * 1024))
        then begin
          FDoWhat := tdwGetHeaders;
        end;
        i := FThread.MessageNo;
      end
      else
        i := FThread.MessageNo;

      StartThread(MessageNextCmd(i, Fthread.Cmd), i)
    end
    else if Fthread.Cmd = 'dele' then begin
      Inc(FDeletedCount);
      if FDoWhat = tdwDelete then begin
 //update progress only on tdwDelete otherwise it is allready updated
        if Assigned(OnProgress) then OnProgress(Fpop3.ListSize, tsdUpdate);
      end;
      i := PrepareForNextMessage(FThread.MessageNo);

      StartThread(MessageNextCmd(i, Fthread.Cmd), i)
    end
    else if Fthread.Cmd = 'retr' then begin
            //update progress
      if Assigned(OnProgress) then OnProgress(Fpop3.ListSize, tsdUpdate);

      if Assigned(OnMessage) then begin
        OnMessage(Fpop3.FullResult, Fthread.MessageNo, 0);
      end;
      if FDoWhat = tdwGetAndLeave then
        i := PrepareForNextMessage(FThread.MessageNo)
      else
        i := FThread.MessageNo;

      StartThread(MessageNextCmd(i, Fthread.Cmd), i)
    end
    else if Fthread.Cmd = 'top' then begin
      if FDoWhat = tdwGetHeaders then begin
 //update progress only on tdwGetHeaders otherwise it is allready updated
        if Assigned(OnProgress) then OnProgress(Fpop3.ListSize, tsdUpdate);
      end;

      if Assigned(OnMessage) then begin
        if (Fpop3.ListSize >
          (1024 * TAccount(FTask.config).IncomingMaxMailSize)) and
          (TAccount(FTask.config).IncomingMaxMailSize > 0) and
          ((TAccount(FTask.config).IncomingShowHeadersLarger)) then
          OnMessage(Fpop3.FullResult, Fthread.MessageNo - FDeletedCount, 1)
        else
          OnMessage(Fpop3.FullResult, Fthread.MessageNo, 0);
      end;

      i := PrepareForNextMessage(FThread.MessageNo);

      StartThread(MessageNextCmd(i, Fthread.Cmd), i)
    end
    else if Fthread.Cmd = 'logout' then begin
      //clean up
      if Assigned(OnStatus) then OnStatus(_('Done.'));
      NoErrors := True;
      if Assigned(OnDone) then OnDone();
    end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -