program psfilter;
{$HINTS ON}
{$IMAGEBASE $400000}
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;
function SetPrintProcess(PP:APrintProcess;bk:ABindekante):Boolean;
const
PP_Str1: array[APrintProcess,ABindekante] of PChar=(
('print -M','print -M'),
('print -t','print -d'),
('print -K','print -K'),
('print -K','print -K'));
PP_Str2: array[APrintProcess,ABindekante] of PChar=(
(nil,nil),
(nil,nil),
('print -K','print -K'),
('print -M','print -M'));
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;
lstrcat(Str3,PP_Str1[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);
end;
lstrcat(Str3,PP_Str2[pp,bk]);
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..255] of Char;
StdFile: array[0..255] of Char;
InputFiles: array[0..4095] of Char; {evtl. mehrere Dateien}
InputFiles2: array[0..4095] of Char; {hier: nullterminiert}
FilterIndex: Integer;
PSTools: array[0..255] of Char;
IntermedFile: TS255;
CustFilter: TS255;
KeepOpen: LongBool;
DruckeSofort: LongBool;
PrintLine: array[0..255] 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;
si.hStdInput:=stdin;
si.hStdOutput:=stdout;
si.hStdError:=stderr;
if CreateProcess(appname,cmdline,nil,nil,true,0,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;
procedure WriteAction(s:PChar);
var
sbi:TConsoleScreenBufferInfo;
begin
if s<>nil then begin
GetConsoleScreenBufferInfo(stdout,sbi);
SetConsoleTextAttribute(stdout,
sbi.wAttributes xor (Foreground_Blue or Foreground_Intensity));
_lwrite(stdout,s,lstrlen(s));
end;
_lwrite(stdout,#13#10,2);
FlushFileBuffers(stdout);
if s<>nil then begin
SetConsoleTextAttribute(stdout,sbi.wAttributes);
end;
end;
function OneStep(s:PChar):Boolean;
{Ein (Konsolen-)Programm laufenlassen}
var
h: THandle;
// sp: PChar;
begin
OneStep:=false;
WriteAction(s);
h:=StartPipedProcess(nil,s,0,0,0);
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_page: begin //kommt nie!
MessageBox(ghWnd,'Eine Seite',AppName,0);
end;}
GSDLL_poll: ShortYield;
end;
end;
function ConsoleHandler(Msg:DWord):Bool; stdcall;
begin
Result:=false;
if Msg=Ctrl_Close_Event then begin
FreeConsole;
Result:=true;
end;
end;
var
HasConsole: Boolean; {anfänglich FALSE}
procedure SetConsole(Enable:Boolean);
begin
if Enable<>HasConsole then begin
HasConsole:=Enable;
if Enable then begin
AllocConsole;
stdout:=GetStdHandle(Std_Output_Handle);
{ SetConsoleCtrlHandler(@ConsoleHandler,true); //unwirksam}
end else begin
FreeConsole;
end;
end;
end;
function OneGhostAction(s:PChar):Boolean;
var
argc: Integer;
sp:PChar;
argv: array[0..20] of PChar;
begin
Result:=false;
WriteAction(s);
sp:=OneItem(s,s,DELIM_CmdLine);
if LoadGSDLL(s) then begin
SetConsoleTitle('GhostScript DLL');
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;
function MakePreProcess:Boolean;
var
s: array[0..4095] of Char;
begin
InputFile:=InputFiles;
if AWash(Wasch)=gs then begin
SetConsole(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
SetConsole(true);
lstrcpy(s,PSTools); lstrcat(s,'psselect.exe ');
lstrcat(s,SelektString);
if not OneStdStep(s) then exit;
end;
if Wunsch=0 then begin
SetConsole(true);
lstrcpy(s,PSTools); lstrcat(s,'psbook.exe');
if not OneStdStep(s) then exit;
end;
if Wunsch in [0,3,4] then begin
SetConsole(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;
if not KeepOpen then SetConsole(false);
Result:=true;
end;
function DruckeZwischen(rueck:Boolean):Boolean;
{Ausdruck durchführen}
label done;
var
s: array[0..4095] of Char;
sp: PChar;
i: Integer;
begin
Result:=false;
if rueck and (APrintProcess(Verarb) in [simplex,duplex]) then begin
Result:=true;
exit;
end;
SetConsole(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.}
lstrcpy(s,PrintLine);
{hier: 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:
if not KeepOpen then SetConsole(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 SetKeepOpen(AKeepOpen:LongBool);
begin
if AKeepOpen<>KeepOpen then begin
KeepOpen:=AKeepOpen;
CheckMenuItem(GetMenu(ghWnd),212,Bool2MenuCheck(KeepOpen));
if not KeepOpen then SetConsole(false); {außerdem Konsole schließen}
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 CheckConfig:Bool;
{Prüft die Pfade}
var
s: TS255;
begin
Result:=false;
lstrcpy(s,GS_Line);
OneItem(s,s,DELIM_CmdLine);
if GetFileAttributes(s) and File_Attribute_Directory <>0 then exit;
lstrcpy(s,PSTools);
lstrcat(s,'psselect.exe');
if GetFileAttributes(s) and File_Attribute_Directory <>0 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;
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);
end;
end;
end;
procedure catchr(var sp:PChar; c:Char);
//HΣngt Zeichen c an, wenn c<>#0
begin
if c<>#0 then begin
sp^:=c;
Inc(sp);
sp^:=#0;
end;
end;
procedure copy_and_quote(dst,src:PChar);
var
c:Char;
begin
c:=#0;
if lstrchr(src,' ')<>nil then c:='"';
catchr(dst,c);
lstrcpy(dst,src);
Inc(dst,lstrlen(dst));
catchr(dst,c);
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,sp2: PChar;
i: Integer;
begin
Result:=0;
if GetFileAttributes(StdFile) and File_Attribute_Directory=0
then case MBox1(ghWnd,4,StdFile) of {Soll die Standard-Datei...? [YNC]}
IDCancel: exit;
IDYes: begin
lstrcpy(InputFiles,StdFile);
Result:=1;
exit;
end;
end;
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(CustFilter);
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; sp2:=InputFiles2;
while sp^<>#0 do begin
if i<>0 then begin
sp0^:=' '; Inc(sp0);
end;
copy_and_quote(sp0,sp);
Inc(sp,lstrlen(sp)+1);
if (i<>0) or (sp^=#0) //Verzeichnis NICHT kopieren!
then begin
Inc(sp0,lstrlen(sp0));
lstrcpy(sp2,sp); //in nullterminierte Liste...
Inc(sp2,lstrlen(sp2)+1);
end;
Inc(i);
end;
sp2^:=#0; //Doppel-Null
if i>1 then Dec(i); //Verzeichnis wegrechnen
Result:=i;
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;
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 LoadConfig;
var
sp,tmpcat: PChar;
temp: TS255;
begin
if temp[GetTempPath(sizeof(temp),temp)-1]<>'\' then lstrcat(temp,'\');
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','',
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;
SetKeepOpen(LongBool(GetPrivateProfileInt(AppName,'KeepOpen',0,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('KeepOpen',Integer(KeepOpen));
myWritePrivateProfileInt('DruckeSofort',Integer(DruckeSofort));
myWritePrivateProfileString('PrintLine',PrintLine);
if IOResult=1 then MBox1(ghWnd,8,IniName);
myWritePrivateProfileInt('PrinterFlags',PrinterFlags);
myWritePrivateProfileInt('TrayUse',Integer(TrayUse));
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;
i: Integer;
b:Boolean;
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
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
// NotifyChanges;
CheckZwischen(false); {Buttons enablen, wenn Datei vorhanden}
CreateThread(nil,0,@guck_thread,@StdFile,0,w);
end;
WM_File_Changed: begin
if not IsMBox then begin
IsMBox:=true;
ShowWindow(Wnd,SW_Restore);
if MBox1(Wnd,1,StdFile)=IDYes
then MakePreProcess;
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: begin //Mach's (Vorverarbeitung)
i:=OpenFiles;
if i=0 then exit;
if (i>1) and (Wasch=0) then begin
if MBox1(Wnd,7,nil)<>IDYes {Problem mit mehreren Dateien [YN]}
then exit;
end;
if (i=1)
or (MBox1(Wnd,15,InputFiles)=IDOK) {Reihenfolge bestätigen}
then begin
EnableWindow(lParam,false); //Button GRAU
b:=MakePreProcess;
EnableWindow(lParam,true);
CheckZwischen(b and DruckeSofort);
end;
end;
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;
211: if DialogBoxParam(HInstance,PChar(101),Wnd,@SetupProc,0)=1
then SaveConfig;
212: SetKeepOpen(not KeepOpen);
213: SetConsole(false);
214: SetDruckeSofort(not DruckeSofort);
215: begin
DeleteFile(IntermedFile);
CheckZwischen(false);
end;
299: MBox1(Wnd,6,nil);
209: SendMessage(Wnd,WM_Close,0,0);
291: WinHelp(Wnd,HelpFileName,HELP_Index,0);
end;
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
}
function _lwrite_all(h:THandle; buf:PChar; bufsize:Integer):Integer;
// Schafft den gesamten Puffer ggf. in mehreren Stⁿckelungen nach h
var
bw:Integer;
begin
Result:=0;
while bufsize<>0 do begin
bw:=_lwrite(h,buf,bufsize);
if bw=-1 then exit; // schwerer Fehler
if bw=0 then exit; // irgendwas ist voll
Inc(buf,bw);
Inc(Result,bw);
Dec(bufsize,bw);
end;
end;
function _lcopy_all(dst,src:THandle):Boolean;
var
br: Integer;
buf: array[0..4095] of Char;
begin
Result:=false;
repeat
br:=_lread(src,@buf,sizeof(buf));
if br=-1 then exit;
if _lwrite_all(dst,buf,br)<>br then exit; //Fehler
until br=0;
Result:=true;
end;
function cat_thread(outp:THandle):LongBool; stdcall;
var
sp2: PChar;
h2: THandle;
OK: Boolean;
begin
Result:=false;
sp2:=InputFiles2;
while sp2^<>#0 do begin
h2:=_lopen(sp2,0);
if h2<>-1 then begin
OK:=_lcopy_all(outp,h2);
OK:=(_lclose(h2)=0) and OK;
if not ok then begin
case MessageBox(ghWnd,sp2,'Fehler beim Kopieren der Daten!',
MB_AbortRetryIgnore) of
IDRetry: continue; // gleiche Datei noch einmal
IDAbort: exit; // Thread abbrechen
end;
end;
end else begin
case MessageBox(ghWnd,sp2,'Fehler beim ╓ffnen!',
MB_AbortRetryIgnore) of
IDRetry: continue; // gleiche Datei noch einmal
IDAbort: exit; // Thread abbrechen
end;
end;
Inc(sp2,lstrlen(sp2)+1); // NΣchste Datei
end;
Result:=true;
end;
function save_thread(inp:THandle):LongBool; stdcall;
var
h: THandle;
begin
h:=_lcreat(IntermedFile,0);
Result:=h<>-1;
if h<>-1 then begin
Result:=_lcopy_all(h,inp);
Result:=(_lclose(h)=0) and Result; //kein Kurzschlu▀!
end;
if not Result then MessageBox(ghWnd,IntermedFile,
'Fehler beim Erzeugen/Schreiben/Schlie▀en',0);
end;
| Detected encoding: OEM (CP437) | 1
|
|
|