program psfilter;
{$HINTS ON}
{$APPTYPE GUI}
{$IMAGEBASE $400000}
{$S+,R+,Q+,I+}
uses Windows, Messages, CommDlg, ShellApi, WUtils32, Parser32, gsdll32;
{$R psfilter}
{ $R psf_en}
const
ImageBase=$400000;
var
ghIcon:HIcon;
ghWnd: HWnd;
type
AWash=(nowash,gs);
ASelect=(nosel,sel);
APreprocess=(none,psnup,psbook);
ABindekante=(kurz,lang);
APrintProcess=(simplex,duplex,batch_u,batch_o);
var
PrinterFlags: UInt; {Bit0=ObenDruck,Bit1=UntenStapel}
procedure CatPipe(s:PChar);
begin
if s^<>#0 then lstrcat(s,' | ');
end;
function SetPreprocess(ww:AWash;se:ASelect;ss:PChar;PP:APreprocess):Boolean;
var
s: array[0..127] of Char;
begin
s[0]:=#0;
if ww=gs then lstrcat(s,'gs_pipe');
if (se=sel) and (lstrlen(ss)>0) then begin
CatPipe(s);
wvsprintf(s+lstrlen(s),'psselect %s',ss);
end;
if PP<>none then begin
if PP=psbook then begin
CatPipe(s);
lstrcat(s,'psbook')
end;
CatPipe(s);
lstrcat(s,'psnup -2');
end;
SetDlgItemText(ghWnd,120,s);
Result:=true;
end;
const
PP_Options: array[Boolean,APrintProcess,ABindekante] of Char=((
('M','M'),
('T','D'),
('K','K'),
('K','K')
),(
(#00,#00),
(#00,#00),
('K','K'),
('M','M')
));
function SetPrintProcess(PP:APrintProcess;bk:ABindekante):Boolean;
var
Str3: TS255; {jetzt in Resource für Überserzbarkeit}
begin
Str3[0]:=#0;
if PP in [batch_u,batch_o] then begin
lstrcpy(Str3,'psselect -e');
if (PP=batch_o)
xor (PrinterFlags and 1 <>0)
xor (PrinterFlags and 2 <>0)
then lstrcat(Str3,' -r');
CatPipe(Str3);
end;
wsprintf1(Str3+lstrlen(Str3),'print -%c',PChar(PP_Options[false,pp,bk]));
SetDlgItemText(ghWnd,121,Str3);
Str3[0]:=#0;
if PP in [batch_u,batch_o] then begin
lstrcpy(Str3,'psselect -o');
if PrinterFlags and 1 <>0
then lstrcat(Str3,' -r');
CatPipe(Str3);
wsprintf1(Str3+lstrlen(Str3),'print -%c',PChar(PP_Options[true,pp,bk]));
end;
SetDlgItemText(ghWnd,122,Str3);
LoadString(HInstance,16+Integer(pp)*2+Integer(bk),Str3,sizeof(Str3));
SetDlgItemText(ghWnd,123,Str3);
Result:=true;
end;
var
Wunsch,Verarb,Wasch,Selekt:Integer;
SelektString:array[0..31] of Char;
procedure ShowPrintProcess;
begin
SetPrintProcess(APrintProcess(Verarb),ABindekante(odd(Wunsch)));
end;
procedure ShowPreProcess;
var
pp:APreprocess;
begin
case Wunsch of
0: pp:=psbook;
3,4: pp:=psnup;
else pp:=none;
end;
SetPreprocess(AWash(Wasch),ASelect(Selekt),SelektString,pp);
end;
procedure NotifyChanges;
begin
ShowPreprocess;
ShowPrintProcess;
end;
var
GS_Line: array[0..511] of Char;
StdFile: TS255;
InputFiles: array[0..4095] of Char; {evtl. mehrere Dateien}
FilterIndex: Integer;
PSTools: TS255;
IntermedFile: TS255;
CustFilter: TS255;
AutoOpen: LongBool;
DruckeSofort: LongBool;
PrintLine: array[0..511] of Char;
const
AppName='PSFilter';
var
HelpFileName:TS255;
function StartPipedProcess(appname,cmdline:PChar;stdin,stdout,stderr:THandle):THandle;
var
si:TStartupInfo;
pi:TProcessInformation;
begin
Result:=0;
ZeroMemory(@si,sizeof(si));
si.cb:=sizeof(si);
si.dwFlags:=STARTF_UseStdHandles or STARTF_ForceOffFeedback
or STARTF_UseShowWindow;
if SW_Hide<>0 then si.wShowWindow:=SW_Hide;
si.hStdInput:=stdin;
si.hStdOutput:=stdout;
si.hStdError:=stderr;
if CreateProcess(appname,cmdline,nil,nil,true,
Detached_Process,nil,nil,si,pi)
then Result:=pi.hProcess
else MBox1(ghWnd,3,PChar(GetLastError)); {Fehler beim Starten des Prozesses}
end;
var
TempSrc,TempDst: TS255;
function MyMove(src,dst:PChar):Boolean; stdcall;
{eigene Version; meckert, wenn was schiefgeht.
MoveFileEx scheint ja nicht zu funktionieren!}
begin
Result:=true;
repeat
DeleteFile(dst); {egal was dabei herauskommt}
if MoveFile(src,dst) then exit; {fertig}
if not CopyFile(src,dst,false)
then case MBox(ghWnd,2,src) of {Datei umbenennen: Fehler %s %s [ARI]}
IDRetry: continue;
IDAbort: begin Result:=false; exit; end;
end;
until true;
DeleteFile(src);
end;
var
stdout: THandle;
piperead: THandle;
ghConsoleWnd: HWnd;
ghConsoleEdit: HWnd;
procedure Expand_0A_0D0A(dst,src:PChar);
label normal;
begin
repeat
case src^ of
#0: break; {Raus bei Ende}
#13: ; {ignorieren}
#10: begin dst^:=#13; Inc(dst); goto normal; end;
else
normal:
dst^:=src^; Inc(dst);
end;
Inc(src);
until false;
dst^:=#0;
end;
function putedit_thread(x:PChar):LongInt; stdcall;
var
buf:TS255;
buf2:array[0..511] of Char; {im schlimmsten Fall doppelt!}
begin
repeat
buf[_lread(piperead,Pointer(@buf),sizeof(buf)-1)]:=#0;
Expand_0A_0D0A(buf2,buf);
SendMessage(ghConsoleEdit,EM_SetSel,UInt(-1),UInt(-1));
SendMessage(ghConsoleEdit,EM_ReplaceSel,0,LongInt(@buf2));
until false;
end;
procedure SetConsole(Enable:Boolean);
begin
if Enable<>IsWindowVisible(ghConsoleWnd) then begin
ShowWindow(ghConsoleWnd,Integer(Enable)); //SW_ShowNormal
CheckMenuItem(GetMenu(ghWnd),212,Bool2MenuCheck(Enable));
end;
end;
function ConsoleWndProc(Wnd:HWnd; Msg,wParam,lParam:UInt):LongInt; stdcall;
var
wPar: LongRec absolute wParam;
lPar: LongRec absolute lParam;
w: DWord;
s: TS63;
begin
Result:=0;
case Msg of
WM_InitDialog: begin
ghConsoleWnd:=Wnd;
ghConsoleEdit:=GetDlgItem(Wnd,10);
if CreatePipe(piperead,stdout,nil,0)
and (CreateThread(nil,0,@putedit_thread,nil,0,w)<>0)
then begin
LoadString(HInstance,24,s,sizeof(s));
InsertMenu(GetSystemMenu(Wnd,false),0,0,$100,s);
end else MBox1(ghWnd,25,PChar(GetLastError));
Result:=1;
end;
WM_SysCommand: case wPar.lo and $FFF0 of
$100: SetWindowText(ghConsoleEdit,nil);
end;
WM_Size: MoveWindow(ghConsoleEdit,0,0,lPar.lo,lPar.hi,true);
WM_Close: SetConsole(false); {nur verbergen!}
end;
end;
procedure WriteAction(s:PChar);
begin
if s<>nil then _lwrite(stdout,s,lstrlen(s));
_lwrite(stdout,PChar(#10),1);
end;
function OneStep(s:PChar):Boolean;
{Ein (Konsolen-)Programm laufenlassen}
var
h: THandle;
begin
OneStep:=false;
WriteAction(s);
h:=StartPipedProcess(nil,s,0,stdout,stdout);
if h=0 then begin
MBox1(ghWnd,3,PChar(GetLastError));
exit;
end;
repeat
ShortYield;
until WaitForSingleObject(h,100)<>WAIT_TimeOut;
WriteAction(nil);
OneStep:=true;
end;
var
InputFile:PChar; {Eingabe-Datei für nächsten Prozess}
function OneStdStep(s:PChar):Boolean;
{An die Kommandozeile werden vorher Quell- und Zieldatei angehangen;
die Ergebnisdatei wird zu einer Quelldatei umbenannt.}
begin
lstrcat(s,' ');
lstrcat(s,InputFile);
lstrcat(s,' '); lstrcat(s,TempDst);
Result:=OneStep(s) and MyMove(TempDst,TempSrc);
InputFile:=TempSrc; {Nun mit temporären Dateien weitermachen}
end;
function gsdll_callback(Msg:Integer; str:PChar; Count:UInt):Integer; cdecl;
begin
Result:=0;
case Msg of
GSDLL_stdout: begin
_lwrite(stdout,str,Count);
end;
GSDLL_poll: ShortYield;
end;
end;
function OneGhostAction(s:PChar):Boolean;
var
argc: Integer;
sp:PChar;
argv: array[0..30] of PChar;
begin
Result:=false;
WriteAction(s);
sp:=OneItem(s,s,DELIM_CmdLine);
if LoadGSDLL(s) then begin
argv[0]:=s;
argc:=1;
while sp^<>#0 do begin
argv[argc]:=NextItem(sp,DELIM_CmdLine);
Inc(argc);
end;
argv[argc]:=nil;
if gsdll.init(gsdll_callback,ghWnd,argc,@argv[0])=0 then begin
gsdll.execute_begin;
gsdll.execute_end;
gsdll.exit;
end else begin
MBox1(ghWnd,14,nil); exit;
end;
end else begin
MBox1(ghWnd,11,s); exit;
end;
WriteAction(nil);
Result:=true;
end;
procedure AutoSetConsole(state:Boolean);
begin
if AutoOpen then SetConsole(state);
end;
function MakePreProcess:Boolean;
var
s: array[0..4095] of Char;
begin
Result:=false;
InputFile:=InputFiles;
if AWash(Wasch)=gs then begin
AutoSetConsole(true);
wsprintf1(s,GS_Line,TempDst);
lstrcat(s,' '); lstrcat(s,InputFiles);
if not OneGhostAction(s) then exit;
if not MyMove(TempDst,TempSrc) then exit;
InputFile:=TempSrc;
end;
if (ASelect(Selekt)=sel) and (lstrlen(SelektString)>0) then begin
AutoSetConsole(true);
lstrcpy(s,PSTools); lstrcat(s,'psselect.exe ');
lstrcat(s,SelektString);
if not OneStdStep(s) then exit;
end;
if Wunsch=0 then begin
AutoSetConsole(true);
lstrcpy(s,PSTools); lstrcat(s,'psbook.exe');
if not OneStdStep(s) then exit;
end;
if Wunsch in [0,3,4] then begin
AutoSetConsole(true);
lstrcpy(s,PSTools); lstrcat(s,'psnup.exe -2');
if not OneStdStep(s) then exit;
end;
if InputFile=InputFiles then begin
if not CopyFile(InputFile,IntermedFile,false) then exit;
end else begin
if not MyMove(InputFile,IntermedFile) then exit;
end;
AutoSetConsole(false);
Result:=true;
end;
function DruckeZwischen(rueck:Boolean):Boolean;
{Ausdruck durchführen}
label done;
var
s: array[0..4095] of Char;
s2: array[0..3] of Char;
sp: PChar;
i: Integer;
begin
Result:=false;
if rueck and (APrintProcess(Verarb) in [simplex,duplex]) then begin
Result:=true;
exit;
end;
AutoSetConsole(true);
InputFile:=IntermedFile; {später: ohne Vorbehandlung direkt Inputfiles}
if not CopyFile(IntermedFile,TempSrc,false) then exit;
if APrintProcess(Verarb) in [batch_u,batch_o] then begin
lstrcpy(s,PSTools); lstrcat(s,'psselect.exe ');
if rueck then begin
sp:='-o';
if PrinterFlags and 1 <>0
then sp:='-o -r';
end else begin
sp:='-e';
if (APrintProcess(Verarb)=batch_o)
xor (PrinterFlags and 1 <>0)
xor (PrinterFlags and 2 <>0)
then sp:='-e -r';
end;
lstrcat(s,sp);
if not OneStdStep(s) then exit;
end;
lstrcpy(s,PrintLine);
OneItem(s,s,DELIM_CmdLine); {erstes Argument abspalten}
for i:=lstrlen(s)-1 downto 0 do begin
if s[i]='.' then begin
sp:=s+i+1;
if lstrcmpi(sp,'dll')=0 then begin {Annahme, es ist GhostScript}
lstrcpy(s,PrintLine);
lstrcat(s,' '); lstrcat(s,InputFile);
OneGhostAction(s);
DeleteFile(TempSrc);
end else if lstrcmpi(sp,'exe')=0 then begin {Es ist ein Print-Kdo.}
wsprintf1(s2,'-%c',PChar(PP_Options[
rueck,APrintProcess(Verarb),ABindekante(odd(Wunsch))]));
wsprintf1(s,PrintLine,s2); {Kommandozeilen-Argument -M -K -T -D anfügen}
lstrcat(s,' '); lstrcat(s,InputFile);
if not OneStep(s) then exit;
DeleteFile(TempSrc);
end else begin {Es ist ein Datei-Name}
CopyFile(InputFile,s,false);
end;
goto done;
end;
end;
CopyFile(InputFile,s,true); {ohne Punkt ist es ein Dateiname}
done:
AutoSetConsole(false);
Result:=true;
end;
procedure Get_LAT(fname:PChar;var lat:TFileTime;var siz:DWord);
var
fh: HFile;
begin
lat.dwLowDateTime:=0;
lat.dwHighDateTime:=0;
siz:=0;
fh:=_lopen(fname,0);
if (fh<>-1) then begin
GetFileTime(fh,nil,nil,@lat);
siz:=GetFileSize(fh,nil);
_lclose(fh);
end;
end;
const
WM_File_Changed=WM_User+2;
function guck_thread(x:PChar):LongInt; stdcall;
{Dieser Thread schaut nach Veränderungen von AUSDRUCK.PS}
var
i:Integer;
path: TS255;
h: THandle;
lat1,lat2: TFileTime;
siz1,siz2: DWord;
begin
lstrcpy(path,x);
for i:=lstrlen(path)-1 downto 0 do begin
if path[i] in ['\','/',':'] then begin
path[i]:=#0; {aus Dateiname Pfad abspalten}
break;
end;
end;
Get_LAT(x,lat1,siz1);
h:=FindFirstChangeNotification(path,false,
FILE_Notify_Change_File_Name or FILE_Notify_Change_Last_Write);
if h<>0 then repeat
WaitForSingleObject(h,Infinite);
Get_LAT(x,lat2,siz2);
if (siz1<>siz2) or (CompareFileTime(lat1,lat2)<>0) then begin
if siz2>0 then PostMessage(ghWnd,WM_File_Changed,0,0);
siz1:=siz2;
lat1:=lat2;
end;
FindNextChangeNotification(h);
until false;
end;
procedure SetAutoOpen(AAutoOpen:LongBool);
begin
if AAutoOpen<>AutoOpen then begin
AutoOpen:=AAutoOpen;
CheckMenuItem(GetMenu(ghWnd),213,Bool2MenuCheck(AutoOpen));
end;
end;
procedure SetDruckeSofort(ADruckeSofort:LongBool);
begin
if ADruckeSofort<>DruckeSofort then begin
DruckeSofort:=ADruckeSofort;
CheckMenuItem(GetMenu(ghWnd),214,Bool2MenuCheck(DruckeSofort));
end;
end;
procedure SetPrinterFlags(APrinterFlags:UInt);
begin
if PrinterFlags<>APrinterFlags then begin
PrinterFlags:=APrinterFlags;
ShowPrintProcess;
end;
end;
procedure WM_ContextMenu_to_WM_Help(Wnd:HWnd;lParam:LongInt);
var
lPar: LongRec absolute lParam;
hi: THelpInfo;
begin
hi.cbSize:=sizeof(hi);
hi.iContextType:=HELPINFO_Window;
hi.MousePos.x:=SmallInt(lPar.lo);
hi.MousePos.y:=SmallInt(lPar.hi);
hi.hItemHandle:=WindowFromPoint(hi.MousePos);
hi.iCtrlID:=GetDlgCtrlID(hi.hItemHandle);
hi.dwContextID:=0;
SendMessage(Wnd,WM_Help,0,LongInt(@hi));
end;
function FileExist(s:PChar):Bool;
begin
Result:=GetFileAttributes(s) and File_Attribute_Directory =0;
end;
function CheckConfig:Bool;
{Prüft die Pfade}
var
s: TS255;
begin
Result:=false;
lstrcpy(s,GS_Line);
OneItem(s,s,DELIM_CmdLine);
if not FileExist(s) then exit;
lstrcpy(s,PSTools);
lstrcat(s,'psselect.exe');
if not FileExist(s) then exit;
Result:=true;
end;
function CheckConfig2(Wnd:HWnd):Bool;
{prüft die Pfade und meckert}
begin
Result:=CheckConfig;
if not Result then MBox1(Wnd,13,nil);
end;
procedure Idiotentaste(Wnd:HWnd); forward;
function SetupProc(Wnd:HWnd; Msg,wParam,lParam:LongInt):LongInt; stdcall;
var
wPar: LongRec absolute wParam;
lPar: LongRec absolute lParam;
i: Integer;
begin
Result:=0;
case Msg of
WM_InitDialog: begin
SetDlgItemText(Wnd,10,GS_Line);
SetDlgItemText(Wnd,11,StdFile);
SetDlgItemText(Wnd,13,PSTools);
SetDlgItemText(Wnd,14,IntermedFile);
SetDlgItemText(Wnd,15,PrintLine);
SetCheckboxGroup(Wnd,20,21,PrinterFlags);
Result:=1;
end;
WM_ContextMenu: WM_ContextMenu_to_WM_Help(Wnd,lParam);
WM_Command: case wPar.lo of
1: begin
{Normalerweise sollten die angegebenen Pfade geprⁿft werden}
GetDlgItemText(Wnd,10,GS_Line,sizeof(GS_Line));
GetDlgItemText(Wnd,11,StdFile,sizeof(StdFile));
GetDlgItemText(Wnd,13,PSTools,sizeof(PSTools));
i:=lstrlen(PSTools);
if i>0 then begin //nachfolgenden Backslash sichern
Dec(i);
if not (PSTools[i] in [':','\','/'])
then lstrcat(PSTools,'/');
end;
GetDlgItemText(Wnd,14,IntermedFile,sizeof(IntermedFile));
GetDlgItemText(Wnd,15,PrintLine,sizeof(PrintLine));
SetPrinterFlags(GetCheckboxGroup(Wnd,20,21));
if CheckConfig2(Wnd) then EndDialog(Wnd,1);
end;
2: EndDialog(Wnd,2);
9: WinHelp(Wnd,HelpFileName,HELP_Context,1010);
12: Idiotentaste(Wnd);
end;
end;
end;
procedure strcpy_and_quote(dst,src:PChar);
var
fnd: PChar;
begin
fnd:=lstrchr(src,' ');
if fnd<>nil then begin dst^:='"'; inc(dst) end;
lstrcpy(dst,src);
Inc(dst,lstrlen(dst));
if fnd<>nil then begin dst^:='"'; inc(dst); dst^:=#0 end;
end;
function HelpHook(Wnd:HWnd; Msg,wParam,lParam:UInt):UInt; stdcall;
var
nmp: PNMHdr absolute lParam;
begin
Result:=0;
case Msg of
WM_Notify: case nmp^.code of
CDN_Help: WinHelp(Wnd,HelpFileName,HELP_Context,1011);
end;
end;
end;
function OpenFiles:Integer;
var
ofn:TOpenFileName;
s: array[0..4095] of Char; // Platz für mehrere Dateien!
sf,cf: TS255;
sp0,sp: PChar;
i: Integer;
begin
Result:=0;
ZeroMemory(@ofn,sizeof(ofn));
ofn.lStructSize:=sizeof(ofn);
ofn.hWndOwner:=ghWnd;
ofn.lpstrFilter:=sf;
LoadString(HInstance,5,sf,sizeof(sf));
ofn.lpstrCustomFilter:=cf;
lstrcpy(cf,CustFilter); {hier nicht verändern lassen!}
ofn.nFilterIndex:=FilterIndex;
ofn.nMaxCustFilter:=sizeof(cf);
ofn.lpstrFile:=s; s[0]:=#0;
ofn.nMaxFile:=sizeof(s);
ofn.Flags:=OFN_AllowMultiSelect or OFN_FileMustExist
or OFN_HideReadOnly or OFN_Explorer or OFN_ShowHelp or OFN_EnableHook;
ofn.lpfnHook:=@HelpHook;
if not GetOpenFileName(ofn) then exit;
FilterIndex:=ofn.nFilterIndex;
i:=0;
sp:=s; sp0:=InputFiles;
while sp^<>#0 do begin
if i<>0 then begin
sp0^:=' '; Inc(sp0);
end;
strcpy_and_quote(sp0,sp);
Inc(sp,lstrlen(sp)+1);
if (i<>0) or (sp^=#0) //Verzeichnis NICHT kopieren!
then begin
Inc(sp0,lstrlen(sp0));
end;
Inc(i);
end;
if i>1 then Dec(i); //Verzeichnis wegrechnen
Result:=i;
end;
function OpenFiles_CheckStd:Integer;
begin
Result:=0;
if FileExist(StdFile) then case MBox1(ghWnd,4,StdFile) of
IDCancel: exit; {Soll die Standard-Datei...? [YNC]}
IDYes: begin
lstrcpy(InputFiles,StdFile);
Result:=1; {Genau eine Datei}
exit;
end;
end;
Result:=OpenFiles;
end;
var
IniName: array[0..255] of Char;
function ZwischenMeldung:Integer;
var
M: Word;
begin
M:=StdMBoxStyle;
StdMBoxStyle:=MB_OKCancel;
Result:=MBox1(ghWnd,16+Verarb*2+Integer(Odd(Wunsch)),nil);
StdMBoxStyle:=M;
end;
function CheckZwischen(bDruck:Boolean):Boolean;
{Testet die Existenz der Zwischen-Datei und aktiviert die Knöpfe...}
begin
Result:=GetFileAttributes(IntermedFile) and File_Attribute_Directory =0;
EnableWindow(GetDlgItem(ghWnd,108),Result);
EnableWindow(GetDlgItem(ghWnd,109),Result
and (APrintProcess(Verarb) in [batch_u,batch_o]));
if Result and bDruck then begin
if not DruckeZwischen(false) then exit;
if APrintProcess(Verarb) in [simplex,duplex] then exit;
if ZwischenMeldung<>IDOK then exit;
if not DruckeZwischen(true) then exit;
end;
end;
procedure AllProcess;
var
b:Bool;
begin
EnableWindow(GetDlgItem(ghWnd,107),false); //Button GRAU
b:=MakePreProcess;
if b=false then SetConsole(true); //Meldungen anzeigen
EnableWindow(GetDlgItem(ghWnd,107),true);
CheckZwischen(b and DruckeSofort);
end;
procedure DruckeAlles(i:Integer); {i=Anzahl Dateien}
begin
if i=0 then exit;
if (i>1) and (Wasch=0) then begin
if MBox1(ghWnd,7,nil)<>IDYes {Problem mit mehreren Dateien [YN]}
then exit;
end;
if (i=1)
or (MBox1(ghWnd,15,InputFiles)=IDOK) {Reihenfolge bestätigen}
then AllProcess;
end;
var
TrayUse:LongBool;
traydata: TNotifyIconData;
procedure SetTrayUse(ATrayUse:Bool);
begin
if TrayUse<>ATrayUse then begin
TrayUse:=ATrayUse;
CheckMenuItem(GetSystemMenu(ghWnd,false),9,Bool2MenuCheck(ATrayUse));
if ATrayUse then begin
traydata.cbSize:=sizeof(traydata);
traydata.wnd:=ghWnd;
traydata.uID:=110;
traydata.uFlags:=NIF_Icon or NIF_Tip or NIF_Message;
traydata.uCallbackMessage:=WM_User;
traydata.hIcon:=GetClassLong(ghWnd,GCL_HIcon);
GetWindowText(ghWnd,traydata.szTip,sizeof(traydata.szTip));
if IsIconic(ghWnd) then begin
if Shell_NotifyIcon(NIM_Add,@traydata)
then ShowWindow(ghWnd,SW_Hide);
end;
end else begin
if IsIconic(ghWnd) then begin
Shell_NotifyIcon(NIM_Delete,@traydata);
ShowWindow(ghWnd,SW_ShowMinimized);
end;
end;
end;
end;
procedure HandleDrop(hDrop:THandle);
var
i,k: Integer;
sp: PChar;
s: TS255;
begin
k:=DragQueryFile(hDrop,-1,nil,0);
sp:=InputFiles;
for i:=0 to k-1 do begin
DragQueryFile(hDrop,i,s,sizeof(s));
if i<>0 then begin
sp^:=' '; Inc(sp);
end;
strcpy_and_quote(sp,s);
Inc(sp,lstrlen(sp));
end;
DruckeAlles(k);
end;
function FindFile(hint,fname:PChar):Boolean;
{Rekursive Suche, die das aktuelle Verzeichnis verändert!
Normalerweise ist hint='*', aber so können Verzeichnis-Namen
eingegrenzt werden. Erst wird im aktuellen Verzeichnis der
Dateiname lokalisiert, wenn nicht gefunden, Verzeichnisse,
die auf <hint> passen, druchsucht. <fname> darf keine Wildcards haben.
Bei Rückgabe von TRUE enthält das aktuelle Vrz. die Datei,
bei FALSE sollte das Verzeichnis ursprünglich sein.}
var
FD: TWin32FindData;
fh: THandle;
begin
Result:=FileExist(fname);
if Result=true then exit;
fh:=FindFirstFile(hint,FD);
if fh<>0 then begin
repeat
if (FD.dwFileAttributes and File_Attribute_Directory<>0)
and (FD.cFileName[0]<>'.')
and SetCurrentDirectory(FD.cFileName) then begin
Result:=FindFile(hint,fname);
if (not Result)
and (not SetCurrentDirectory('..')) then break; {sollte gehen!}
end;
until not FindNextFile(fh,fd);
FindClose(fh);
if Result=true then exit; {Datei-Match gefunden}
end;
end;
function StartFindFile(start,hint,fname:PChar):Boolean;
begin
Result:=SetCurrentDirectory(start) and FindFile(hint,fname);
end;
function RQVE(key:HKey;tag,value:PChar; vsize:DWord):Boolean;
{Ein programmiererfreundliches RegQueryValueEx}
begin
Result:=RegQueryValueEx(key,tag,nil,nil,PByte(value),@vsize)=0;
end;
function GetRegString(key:HKey;path,tag,value:PChar; vsize:DWord):Bool;
begin
if RegOpenKey(key,path,key)=0 then begin
Result:=RQVE(key,tag,value,vsize);
RegCloseKey(key);
end;
end;
var
GSINI: TS255;
function GetGsIniOption(key,default,value:PChar):Integer;
begin
if value<>nil then begin
Result:=GetPrivateProfileString('Options',key,default,value,256,GSINI);
end else begin
Result:=GetPrivateProfileInt('Options',key,Integer(default),GSINI);
end;
end;
function FindGSIni:Boolean;
const
IniName:array[0..13] of Char='\gsview32.ini';
begin
Result:=false;
lstrcpy(GSINI,IniName+1);
if GetGsIniOption('Configured',PChar(0),nil)=1 then begin
Result:=true;
exit;
end;
if GetRegString(HKEY_Current_User,
'Software\Microsoft\Windows\CurrentVersion\ProfileReconciliation',
'ProfileDirectory',GSINI,sizeof(GSINI)) then begin
lstrcat(GSINI,IniName+0);
if GetGsIniOption('Configured',PChar(0),nil)=1 then Result:=true;
end;
end;
function SucheProgrammPfad(Hint,SeekName:PChar):Boolean;
var
FindPath: TS255;
c: Char;
b: Boolean;
begin
Result:=true;
if FindFile(Hint,SeekName) then exit; {erst im aktuellen Vrz. probieren}
GetRegString(HKEY_Local_Machine,
'Software\Microsoft\CurrentVersion',
'ProgramFilesDir',FindPath,sizeof(FindPath));
for b:=lstrcmp(Hint,'*')<>0 downto false do begin
{Zwei Läufe nur wenn Hint<>'*'}
if StartFindFile(FindPath,Hint,SeekName) then exit;
for c:='A' to 'Z' do begin
wvsprintf(FindPath,'%c:\',c);
if (GetDriveType(FindPath)=DRIVE_Fixed)
{Nicht das ganze Internet (AFS!) durchsuchen!}
and StartFindFile(FindPath,Hint,SeekName)
then exit;
end;
Hint:='*'; {im zweiten Lauf alle Verzeichnisse!}
end;
Result:=false;
end;
function SucheProgramm(Hint,SeekName,FindName:PChar;fnlen:DWord):Boolean;
var
i: DWord;
begin
Result:=SucheProgrammPfad(Hint,SeekName);
if Result then begin
i:=GetCurrentDirectory(fnlen-1,FindName);
if (i>0) and (FindName[i-1]<>'\') then begin
FindName[i]:='\'; Inc(i);
end;
lstrcpyn(FindName+i,SeekName,fnlen-i);
end;
end;
function MkGhostScriptLineStart(s:PChar):Boolean;
{Macht sich auf die Suche nach GhostScript, und zapft dazu folgende
Infos an:
* die gsview32.ini im Windows- oder im Windows\Profiles\username-Vrz.
* die Registry-Eintragungen von GhostScript unter wechselnden Namen
* durch das Durchsuchen aller Festplatten, beginnend mit C:\Programme}
var
key1,key2,key3: HKey;
n: DWORD;
sp: PChar;
keyname,dllpath,libpath: TS255;
begin
if FindGsIni then begin
GetGsIniOption('GhostScriptDLL','',dllpath);
GetGsIniOption('GhostScriptInclude','',libpath);
end else begin
if RegOpenKey(HKEY_Local_Machine,'Software',key1)=ERROR_Success
then begin
n:=0;
repeat
if RegEnumKey(key1,n,keyname,sizeof(keyname))<>ERROR_Success
then break;
if (lstrstr('GhostScript',keyname,lstrcmpi)<>nil)
and (RegOpenKey(key1,keyname,key2)=ERROR_Success)
and (RegEnumKey(key2,0,keyname,sizeof(keyname))=ERROR_Success)
and (RegOpenKey(key2,keyname,key3)=ERROR_Success)
then begin
RQVE(key3,'GS_DLL',dllpath,sizeof(dllpath));
RQVE(key3,'GS_LIB',libpath,sizeof(dllpath));
break;
end;
Inc(n);
until false;
end;
end;
if not FileExist(dllpath) then begin
if SucheProgramm('g*','gsdll32.dll',dllpath,sizeof(dllpath)) then begin
SetCurrentDirectory('..');
SucheProgramm('lib','gs_init.ps',libpath,sizeof(libpath));
sp:=libpath+lstrlen(libpath)-11; {11 Zeichen "\gs_init.ps"}
sp^:=';'; Inc(sp);
SetCurrentDirectory('..\..');
SucheProgramm('fonts','n019003l.afm',sp,sizeof(libpath));
end else begin
MBox1(ghWnd,13,nil);
Result:=false;
exit;
end;
end;
wsprintf2(s,'%s -I%s ',dllpath,libpath);
end;
procedure Idiotentaste(Wnd:HWnd);
var
sp:PChar;
s,s2: TS255;
begin
SetDlgItemText(Wnd,10,nil);
SetDlgItemText(Wnd,13,nil);
SetDlgItemText(Wnd,15,nil);
SetCursor(LoadCursor(0,IDC_Wait));
if MkGhostScriptLineStart(s) then begin
lstrcat(s,'-sPAPERSIZE=a4 -dNOPAUSE -dBATCH -sDEVICE=');
sp:=s+lstrlen(s);
lstrcpy(sp,'pswrite -sOutputFile=%s');
SetDlgItemText(Wnd,10,s);
GetProfileString('devices',nil,'',s2,sizeof(s2)); {Lokaler Drucker?}
if s2[0]<>#0 then begin
wsprintf1(sp,'mswinpr2 -sOutputFile="%s"',s2);
end else begin
GetTempPath(sizeof(s),s);
lstrcat(s,'print_me.prn');
end;
SetDlgItemText(Wnd,15,s);
SetCurrentDirectory('..');
end;
if SucheProgramm('ps*','psselect.exe',s,sizeof(s))
then begin
s[lstrlen(s)-12]:=#0; {nur bis inklusive Backslash}
SetDlgItemText(Wnd,13,s);
end;
SetCursor(LoadCursor(0,IDC_Arrow));
end;
procedure LoadConfig;
var
sp,tmpcat: PChar;
temp: TS255;
begin
if temp[GetTempPath(sizeof(temp),temp)-1]<>'\' then lstrcat(temp,'\');
tmpcat:=temp;
repeat {\ durch / ersetzen: es geht doch!}
tmpcat:=lstrchr(tmpcat,'\');
if tmpcat=nil then break;
tmpcat^:='/';
Inc(tmpcat);
until false;
tmpcat:=temp+lstrlen(temp); {auf die Null}
lstrcpy(tmpcat,'tmp_a.ps');
lstrcpy(TempSrc,temp);
lstrcpy(tmpcat,'tmp_b.ps');
lstrcpy(TempDst,temp);
if IniName[0]=#0 then begin
sp:=IniName+GetModuleFileName(ImageBase,IniName,sizeof(IniName));
while (sp>IniName) and ((sp-1)^<>'\') do Dec(sp);
lstrcpy(sp,'PSFilter.INI');
end;
Wunsch:=GetPrivateProfileInt(AppName,'Wunsch',0,IniName);
Verarb:=GetPrivateProfileInt(AppName,'Verarb',1,IniName);
Wasch:= GetPrivateProfileInt(AppName,'Wasch', 1,IniName);
Selekt:=GetPrivateProfileInt(AppName,'Selekt',0,IniName);
GetPrivateProfileString(AppName,'SelektString','',
SelektString,sizeof(SelektString),IniName);
GetPrivateProfileString(AppName,'GS_Line',
'C:/Programme/ghost/gs7.00/bin/gsdll32.dll '+
'-IC:/Programme/ghost/gs7.00/fonts '+
'-sPAPERSIZE=a4 -sDEVICE=pswrite -dNOPAUSE -dBATCH -sOutputFile=%s',
GS_Line,sizeof(GS_Line),IniName);
lstrcpy(tmpcat,'Ausdruck.ps');
GetPrivateProfileString(AppName,'StdFile',temp,
StdFile,sizeof(StdFile),IniName);
FilterIndex:=GetPrivateProfileInt(AppName,'FilterIndex',0,IniName);
GetPrivateProfileString(AppName,'PSTools','C:/Programme/ghost/PSTOOLS/',
PSTools,sizeof(PSTools),IniName);
lstrcpy(tmpcat,'Zwischen.ps');
GetPrivateProfileString(AppName,'IntermedFile',temp,
IntermedFile,sizeof(IntermedFile),IniName);
GetPrivateProfileString(AppName,'CustFilter','',
CustFilter,sizeof(CustFilter),IniName);
sp:=lstrchr(CustFilter,'#');
if sp<>nil then sp^:=#0;
SetAutoOpen(LongBool(GetPrivateProfileInt(AppName,'AutoOpen',1,IniName)));
SetDruckeSofort(LongBool(GetPrivateProfileInt(AppName,'DruckeSofort',0,IniName)));
GetPrivateProfileString(AppName,'PrintLine',
'C:/Programme/ghost/gs7.00/bin/gsdll32.dll '+
'-IC:/Programme/ghost/gs7.00/fonts '+
'-sPAPERSIZE=a4 -sDEVICE=ljet4 -dNOPAUSE -dBATCH -sOutputFile=lpt1',
PrintLine,sizeof(PrintLine),IniName);
SetPrinterFlags(GetPrivateProfileInt(AppName,'PrinterFlags',0,IniName));
SetTrayUse(Bool(GetPrivateProfileInt(AppName,'TrayUse',0,IniName)));
end;
procedure myWritePrivateProfileInt(key:PChar; i:Integer);
var
s: array[0..7] of Char;
begin
wsprintf1(s,'%d',PChar(i));
if not WritePrivateProfileString(AppName,key,s,IniName)
then InOutRes:=1;
end;
procedure myWritePrivateProfileString(key,value:PChar);
begin
if not WritePrivateProfileString(AppName,key,value,IniName)
then InOutRes:=1;
end;
procedure SaveConfig;
var
SP: PChar;
begin
myWritePrivateProfileInt('Wunsch',Wunsch);
myWritePrivateProfileInt('Verarb',Verarb);
myWritePrivateProfileInt('Wasch',Wasch);
myWritePrivateProfileInt('Selekt',Selekt);
myWritePrivateProfileString('SelektString',SelektString);
myWritePrivateProfileString('GS_Line',GS_Line);
myWritePrivateProfileString('StdFile',StdFile);
myWritePrivateProfileInt('FilterIndex',FilterIndex);
myWritePrivateProfileString('PSTools',PSTools);
myWritePrivateProfileString('IntermedFile',IntermedFile);
sp:=CustFilter+lstrlen(CustFilter);
sp^:='#'; {als Trennzeichen beim Speichern}
myWritePrivateProfileString('CustFilter',CustFilter);
sp^:=#0;
myWritePrivateProfileInt('AutoOpen',Integer(AutoOpen));
myWritePrivateProfileInt('DruckeSofort',Integer(DruckeSofort));
myWritePrivateProfileString('PrintLine',PrintLine);
myWritePrivateProfileInt('PrinterFlags',PrinterFlags);
myWritePrivateProfileInt('TrayUse',Integer(TrayUse));
if IOResult=1 then MBox1(ghWnd,8,IniName);
end;
procedure ModifySystemMenu;
var
sysm: HMenu;
s: TS63;
begin
sysm:=GetSystemMenu(ghWnd,false);
if Swap(Word(GetVersion))>=3*256+95 then begin
LoadString(HInstance,9,s,sizeof(s));
ModifyMenu(sysm,SC_Size,0,9,s);
end else DeleteMenu(sysm,SC_Size,0);
LoadString(HInstance,10,s,sizeof(s));
ModifyMenu(sysm,SC_Maximize,0,10,s);
end;
function ChangeFont(Wnd:HWnd):HFont;
var
lf:TLogFont;
begin
Result:=SendMessage(Wnd,WM_GetFont,0,0);
GetObject(Result,sizeof(lf),@lf);
lf.lfWeight:=700;
Result:=CreateFontIndirect(lf);
if Result<>0 then SendMessage(Wnd,WM_SetFont,Result,0);
end;
function MainDlgProc(Wnd:HWnd; Msg,wParam,lParam:LongInt):LongInt; stdcall;
const
WM_ContinueInit=WM_User+100;
BoldFont:HFont=0;
IsMBox:Boolean=false;
var
wPar: LongRec absolute wParam;
lPar: LongRec absolute lParam;
hi: PHelpInfo absolute lParam;
w:HWnd;
sysm:HMenu;
P: TPoint;
begin
Result:=0;
case Msg of
WM_InitDialog: begin
ghWnd:=Wnd;
SetClassLong(Wnd,GCL_HIcon,ghIcon); //erlaubt bei 32bit
ModifySystemMenu;
lstrcpy(HelpFileName+GetModuleFileName( {EXE->HLP}
ImageBase,HelpFileName,sizeof(HelpFileName))-3,'HLP');
ShowWindow(Wnd,SW_Show); //SW_Show ist sinnlos wegen Widrigkeiten
DragAcceptFiles(Wnd,true); {irgendwie reicht's in der Ressource nicht!}
PostMessage(Wnd,WM_ContinueInit,0,0);
Result:=1;
end;
WM_ContinueInit: begin
if IsZoomed(Wnd) then ShowWindow(Wnd,SW_Hide); {Code für "Verbergen"!}
LoadConfig;
if not CheckConfig2(Wnd) then PostMessage(Wnd,WM_Command,211,0);
BoldFont:=ChangeFont(GetDlgItem(Wnd,123));
CheckDlgButton(Wnd,100+Wunsch,1); //Druck-Wunsch
CheckDlgButton(Wnd,110+Verarb,1); //Papier-Verarbeitung
CheckDlgButton(Wnd,105,Wasch); //"Waschen" standardmΣ▀ig ein
CheckDlgButton(Wnd,106,Selekt);
w:=GetDlgItem(Wnd,116);
if Selekt<>0 then EnableWindow(w,true);
SetWindowText(w,SelektString); // l÷st NotifyChanges aus
CheckZwischen(false); {Buttons enablen, wenn Datei vorhanden}
CreateThread(nil,0,@guck_thread,@StdFile,0,w);
CreateDialogParam(HInstance,MakeIntResource(102),0,@ConsoleWndProc,0);
end;
WM_File_Changed: begin
if not IsMBox then begin
IsMBox:=true;
ShowWindow(Wnd,SW_Restore);
if MBox1(Wnd,1,StdFile)=IDYes
then begin
lstrcpy(InputFiles,StdFile);
AllProcess;
end;
IsMBox:=false;
end;
end;
WM_SysCommand: case wPar.lo of
9: SetTrayUse(not TrayUse);
10: ShowWindow(Wnd,SW_Hide);
end;
WM_User: case lParam of
WM_LButtonDown: begin
ShowWindow(Wnd,SW_ShowNormal);
end;
WM_RButtonDown: begin
sysm:=GetSystemMenu(Wnd,false);
GetCursorPos(P);
TrackPopupMenu(sysm,TPM_RightAlign or TPM_RightButton,
P.x,P.y,0,Wnd,nil);
DestroyMenu(sysm);
end;
end;
WM_Size: case wPar.lo of
SIZE_Minimized: if TrayUse then begin
if Shell_NotifyIcon(NIM_Add,@traydata)
then ShowWindow(Wnd,SW_Hide);
end;
SIZE_Restored: if TrayUse then Shell_NotifyIcon(NIM_Delete,@traydata);
end;
WM_Command: case wPar.lo of
2: CloseWindow(Wnd);
9: SetTrayUse(false); {Ende Tray}
100..104: begin Wunsch:=wPar.lo-100; NotifyChanges; end;
105: begin Wasch:=IsDlgButtonChecked(Wnd,105); NotifyChanges; end;
106: begin
Selekt:=IsDlgButtonChecked(Wnd,106);
EnableWindow(GetDlgItem(Wnd,116),Bool(Selekt));
NotifyChanges;
end;
107: DruckeAlles(OpenFiles_CheckStd);
108: DruckeZwischen(false);
109: DruckeZwischen(true);
110..113: begin
Verarb:=wPar.lo-110;
NotifyChanges;
CheckZwischen(false);
end;
116: if wPar.hi=EN_Change then begin
GetDlgItemText(Wnd,116,SelektString,sizeof(SelektString));
NotifyChanges;
end;
201: DruckeAlles(OpenFiles);
209: SendMessage(Wnd,WM_Close,0,0);
211: if DialogBoxParam(HInstance,PChar(101),Wnd,@SetupProc,0)=1
then SaveConfig;
212: SetConsole(not IsWindowVisible(ghConsoleWnd));
213: SetAutoOpen(not AutoOpen);
214: SetDruckeSofort(not DruckeSofort);
215: begin
DeleteFile(IntermedFile);
CheckZwischen(false);
end;
299: MBox1(Wnd,6,nil);
291: WinHelp(Wnd,HelpFileName,HELP_Index,0);
end;
WM_DropFiles: HandleDrop(wParam);
WM_Close: begin
SaveConfig;
WinHelp(Wnd,HelpFileName,HELP_Quit,0);
EndDialog(Wnd,0);
end;
WM_EndSession: SaveConfig;
WM_CtlColorStatic: if GetDlgCtrlID(lParam)=123 then begin
Result:=DefWindowProc(Wnd,Msg,wParam,lParam);
SetTextColor(wParam,GetTextColor(wParam) xor $000080);
end;
WM_ContextMenu: WM_ContextMenu_to_WM_Help(Wnd,lParam);
WM_Help: begin
if hi.iContextType=HelpInfo_Window
then WinHelp(Wnd,HelpFileName,HELP_ContextPopup,hi.iCtrlID)
else WinHelp(Wnd,HelpFileName,HELP_Context,1013);
SetWindowLong(Wnd,DWL_MsgResult,1);
Result:=1;
end;
WM_Destroy: DeleteObject(BoldFont);
end;
end;
var
titelstr: TS63;
hprev: HWnd;
begin
StdMBoxTitle:=AppName;
HInstance:=LoadLibrary('Language.DLL');
if HInstance<=32 then HInstance:=ImageBase;
LoadString(HInstance,12,titelstr,sizeof(titelstr));
hprev:=FindWindow(nil,titelstr);
if hprev<>0 then begin
ShowWindow(hprev,SW_ShowNormal);
SetActiveWindow(hprev);
exit;
end;
ghIcon:=LoadIcon(ImageBase,PChar(100));
DialogBoxParam(HInstance,PChar(100),0,@MainDlgProc,0);
DestroyIcon(ghIcon);
if HInstance<>ImageBase then FreeLibrary(HInstance);
end.
{zu tun:
* Warnung, wenn Seitenzahl nicht /4 bzw. /2 teilbar ist
* Warnung, wenn Vorderseiten-Anzahl <> Rⁿckseiten-Anzahl
}
| Detected encoding: OEM (CP437) | 1
|
|
|