dxlpdservercore.pas

Well known and usefull component for delphi 7

Begin
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PLPDListEvent(fEventArray[Loop]).Command=Command then Begin
         PLPDListEvent(fEventArray[Loop]).EventProcedure:=EventProc;
         Exit;
      End
      Else Inc(Loop);
   End;
   New(PListEvent);
   PListEvent.Tag:=2;      // Denotes Event in fEventArray is a TSimpleEvent!
   PListEvent.Command:=Command;
   PListEvent.EventProcedure:=EventProc;
   fEventArray.Add(PListEvent);
End;

(******************************************************************************
ADDRemoveEVENT:
              Allows you to dynamically assign a new command to the internal
              parser. This allows the servercore to support the 'pre-defined'
              OnCommand* events, plus you can add other commands dynamically
              at run-time in your application without requiring a source code
              modification to our components!

              To make support easier for us, we ask that you use the Add*Event
              procedures to expand our code, reducing code changes when an
              upgrade is released!

              See documentation for complete information on how this works.

              Example Usage: AddRemoveEvent('CDROM',MySpecialEvent);
******************************************************************************)
Procedure TDXLPDServerCore.AddRemoveEvent(Command:Char;EventProc:LPDTQueueRemoveEvent);
Var
   PRemoveEvent:PLPDRemoveEvent;
   Loop:Integer;

Begin
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PLPDRemoveEvent(fEventArray[Loop]).Command=Command then Begin
         PLPDRemoveEvent(fEventArray[Loop]).EventProcedure:=EventProc;
         Exit;
      End
      Else Inc(Loop);
   End;
   New(PRemoveEvent);
   PRemoveEvent.Tag:=3;      // Denotes Event in fEventArray is a TSimpleEvent!
   PRemoveEvent.Command:=Command;
   PRemoveEvent.EventProcedure:=EventProc;
   fEventArray.Add(PRemoveEvent);
End;

(******************************************************************************
ADDQueryEVENT:
              Allows you to dynamically assign a new command to the internal
              parser. This allows the servercore to support the 'pre-defined'
              OnCommand* events, plus you can add other commands dynamically
              at run-time in your application without requiring a source code
              modification to our components!

              To make support easier for us, we ask that you use the Add*Event
              procedures to expand our code, reducing code changes when an
              upgrade is released!

              See documentation for complete information on how this works.

              Example Usage: AddRemoveEvent('CDROM',MySpecialEvent);
******************************************************************************)
Procedure TDXLPDServerCore.AddQueryEvent(Command:Char;EventProc:LPDTQueueQueryEvent);
Var
   PQueryEvent:PLPDQueryEvent;
   Loop:Integer;

Begin
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PLPDQueryEvent(fEventArray[Loop]).Command=Command then Begin
         PLPDQueryEvent(fEventArray[Loop]).EventProcedure:=EventProc;
         Exit;
      End
      Else Inc(Loop);
   End;
   New(PQueryEvent);
   PQueryEvent.Tag:=4;      // Denotes Event in fEventArray is a TSimpleEvent!
   PQueryEvent.Command:=Command;
   PQueryEvent.EventProcedure:=EventProc;
   fEventArray.Add(PQueryEvent);
End;

Procedure TDXLPDServerCore.SetOnCommandPrintWaiting(value:LPDTQueueEvent);
Begin
   fOnCommandPrintWaiting:=Value;
   AddQueueEvent(#1,Value);
End;

Procedure TDXLPDServerCore.SetOnCommandReceiveJob(value:LPDTQueueEvent);
Begin
   fOnCommandReceiveJob:=Value;
   AddQueueEvent(#2,Value);
End;

Procedure TDXLPDServerCore.SetOnCommandSendJob(value:LPDTQueueListEvent);
Begin
   fOnCommandSendJob:=Value;
   AddListEvent(#3,Value);
End;

Procedure TDXLPDServerCore.SetOnCommandQueueQuery(value:LPDTQueueQueryEvent);
Begin
   fOnCommandQueueQuery:=Value;
   AddQueryEvent(#4,Value);
End;

Procedure TDXLPDServerCore.SetOnCommandRemoveJob(value:LPDTQueueRemoveEvent);
Begin
   fOnCommandRemoveJob:=Value;
   AddRemoveEvent(#5,Value);
End;

Procedure TDXLPDServerCore.SayOK(ClientThread:TDXClientThread);
Begin
   ClientThread.Socket.Write(#0);
End;

procedure TDXLPDServerCore.ProcessSession(ClientThread: TDXClientThread);
var
  S:string;
  sCmd:Char;
  Loop:Integer;
  WasHandled:Boolean;

begin
   with ClientThread.Socket do begin
      s:=ReadLn(Timeout);
      If LastReadTimeout or Not ValidSocket then Exit;
      sCmd:=S[1];
      Delete(s,1,1);
      Loop:=0;
      WasHandled:=False;
      While (Loop<fEventArray.Count) and (Not WasHandled) do Begin
         If PLPDQueueEvent(fEventArray[Loop]).Command=sCMD then Begin
            Case PLPDQueueEvent(fEventArray[Loop]).Tag of
               1:if Assigned(PLPDQueueEvent(fEventArray[Loop]).EventProcedure) then
                    LPDTQueueEvent(PLPDQueueEvent(fEventArray[Loop]).EventProcedure)(ClientThread,S);
               2:if Assigned(PLPDListEvent(fEventArray[Loop]).EventProcedure) then
                    LPDTQueueListEvent(PLPDListEvent(fEventArray[Loop]).EventProcedure)(ClientThread,FetchByChar(S,#32,False),S);
               3:if Assigned(PLPDRemoveEvent(fEventArray[Loop]).EventProcedure) then
                    LPDTQueueRemoveEvent(PLPDRemoveEvent(fEventArray[Loop]).EventProcedure)(ClientThread,FetchByChar(S,#32,False),FetchByChar(S,#32,False),S);
               4:if Assigned(PLPDQueryEvent(fEventArray[Loop]).EventProcedure) then
                    LPDTQueueQueryEvent(PLPDQueryEvent(fEventArray[Loop]).EventProcedure)(ClientThread,S);
            End;
            WasHandled:=True;
         End
         Else Inc(Loop);
      End; {while}
      If Not WasHandled then Begin
         if assigned(OnCommandOther) then
            OnCommandOther(ClientThread,sCmd,s,WasHandled);
      end;
      If Not WasHandled then ClientThread.Socket.Write(#255);
   end; {with}
end; {doExecute}

procedure TDXLPDServerCore.ProcessReceiveJobSession(ClientThread:TDXClientThread);
var
   S:string;
   sCmd:Char;
   Chars:Integer;
   Ws:String;
   ControlFile:PLPDControlFile;
   Ts:String;
   FHandle:Integer;
   MaxChars:Integer;
   OutData:Pointer;
   Loop:Integer;
   WasHandled:Boolean;

Begin
   with ClientThread.Socket do begin
      s:=ReadLn(Timeout);
      If (S='') or LastReadTimeout or Not ValidSocket then Exit;
      if assigned({$IFDEF TLS_EDITION}OnReadFilter{$ELSE}OnFilter{$ENDIF}) then begin
         Loop:=FilterRead(@S[1],OutData,Length(S),ClientThread);
         SetLength(S,Loop);
         If Assigned(OutData) then Begin
            FastMove(TDXBSArray(OutData^),S[1],Loop);
{$IFDEF TLS_EDITION}OnReadFilter{$ELSE}OnFilter{$ENDIF}(ddFreePointer,nil,OutData,Loop,Loop,WasHandled,ClientThread) ;
         End;
      End;
      sCmd:=S[1];
      Delete(s,1,1);
      Case Ord(sCmd) of
         1:Begin // request for abort
            SayOK(ClientThread);
         End;
         2:Begin
            SayOK(ClientThread);
            Chars:=StrToInt(FetchByChar(S,#32,False));
            Ws:=S;
            If fControlPath<>'' then Begin
               ForceDirectories(fControlPath);
               fHandle:=FileCreate(AddBackSlash(fControlPath)+Ws);
            End
            Else FHandle:=-1;
            New(ControlFile);
            While Chars>0 do Begin
               Ts:=Readln(5000);
               If (fControlPath<>'') and (fHandle>-1) then
                  FileWrite(fHandle,Ts[1],Length(Ts));
               Chars:=Chars-(Length(Ts)+1);
               sCmd:=Ts[1];
               Delete(Ts,1,1);
               Case sCmd of
                  'C':ControlFile^.ClassStr:=TS;
                  'H':ControlFile^.Host:=TS;
                  'I':ControlFile^.Indent:=StrToInt(TS);
                  'J':ControlFile^.Job:=TS;
                  'L':ControlFile^.UserBanner:=TS;
                  'M':ControlFile^.MailResultsTo:=TS;
                  'N':ControlFile^.SourceFileName:=TS;
                  'P':ControlFile^.UserID:=TS;
                  'S':ControlFile^.SymbolicLinkData:=TS;
                  'T':ControlFile^.Title:=TS;
                  'U':ControlFile^.Unlink:=TS;
                  'W':ControlFile^.Width:=StrToInt(Ts);
// font filenames:
                  '1':ControlFile^.TroffRFont:=Ts;
                  '2':ControlFile^.TroffIFont:=Ts;
                  '3':ControlFile^.TroffBFont:=Ts;
                  '4':ControlFile^.TroffSFont:=Ts;
                  'c':ControlFile^.PlotCIF:=Ts;
                  'd':ControlFile^.PrintDVI:=Ts;
                  'f':ControlFile^.FormattedFile:=Ts;
                  'g':ControlFile^.PlotFile:=Ts;
                  'k':ControlFile^.Kerberized:=Ts;
                  'l':ControlFile^.PrintRAW:=Ts;
                  'n':ControlFile^.DITroff:=Ts;
                  'o':ControlFile^.PostScript:=Ts;
                  'p':ControlFile^.PRFormat:=Ts;
                  'r':ControlFile^.Fortran:=Ts;
                  't':ControlFile^.TroffOutput:=Ts;
                  'v':ControlFile^.Raster:=Ts;
                  'z':ControlFile^.Palladium:=Ts;
               End;
            End;
            GetChar; {should have been Null}
            If (fControlPath<>'') and (fHandle>-1) then
               FileClose(fHandle);
            If Assigned(fOnJobControlFile) then
               fOnJobControlFile(ClientThread,ControlFile)
            Else
               SayOK(ClientThread); // try to limp along!
         End;
         3:Begin
            SayOK(ClientThread);
            Chars:=StrToInt(FetchByChar(S,#32,False));
            MaxChars:=Chars;
            Ws:=S;
            If fSpoolPath<>'' then Begin
               ForceDirectories(fSpoolPath);
               fHandle:=FileCreate(AddBackSlash(fSpoolPath)+Ws);
            End
            Else FHandle:=-1;
            While Chars>0 do Begin
               Ts:=ReadStr(-1);
               If (fSpoolPath<>'') and (fHandle>-1) then
                  FileWrite(fHandle,Ts[1],Length(Ts));
               ProcessWindowsMessageQueue;
            End;
            If (fSpoolPath<>'') and (fHandle>-1) then
               FileClose(fHandle);
            If Assigned(fOnJobSpoolFile) then
               fOnJobSpoolFile(ClientThread,MaxChars,AddBackSlash(fSpoolPath)+Ws)
            Else
               SayOK(ClientThread); // try to limp along!
         End;
      End;
   End;
End;

end.