1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258:
| unit server;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, shellapi;
type TForm1 = class(TForm) ausgabe: TTimer; Panel1: TPanel; zeit: TLabel; eingabe: TTimer; Label1: TLabel; Label2: TLabel; datum: TLabel; fullstring: TLabel; Memo2: TMemo; zeitaktual: TTimer; Memo3: TMemo; Label3: TLabel; Memo1: TMemo; Image1: TImage; Timer1: TTimer; procedure Timer1Timer(Sender: TObject); procedure zeitaktualTimer(Sender: TObject); procedure eingabeTimer(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ausgabeTimer(Sender: TObject); private
public Procedure ausgeben; Procedure einlesen; procedure zeilendeleter;
end;
var Form1: TForm1; Standart :String; besetzt : boolean; sl: TStringList; datum_von,zeit_von : array[1..10] of string; datum_bis,zeit_bis : array[1..10] of string; Programm : array[1..10] of string; liste:TStringList; x2 : integer;
implementation
{$R *.dfm}
function GetScreenShot: TBitmap; var Desktop: HDC; begin Result := TBitmap.Create; Desktop := GetDC(0); try try Result.PixelFormat := pf32bit; Result.Width := Screen.Width; Result.Height := Screen.Height; BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY); Result.Modified := True; finally ReleaseDC(0, Desktop); end; except Result.Free; Result := nil; end; end;
procedure TForm1.zeilendeleter; var i:integer; begin
liste := TStringList.Create; liste.LoadFromFile('daten\daten.txt'); Memo3.Text := liste.Text; liste.Clear; Memo3.Text:=StringReplace(memo3.text, fullstring.caption, '00.00.0000,00.00.0000,00:00:00,00:00:00,Standart.pps', [rfReplaceAll]); liste.Text := memo3.text; liste.SaveToFile('daten\daten.txt');
end;
Procedure TForm1.einlesen; var i,x,y:integer; begin memo1.clear; sl := TStringList.Create; sl.LoadFromFile('daten\daten.txt');
Memo1.Text := sl.Text;
label1.caption:=inttostr(sl.count);
sl.Delimiter := ','; sl.DelimitedText := memo1.text;
y:=0; for x:= 1 to 10 do begin datum_von[x]:=sl.strings[y]; y:=y+5; end;
y:=1; for x:= 1 to 10 do begin datum_bis[x]:=sl.strings[y]; y:=y+5; end;
y:=2; for x:= 1 to 10 do begin zeit_von[x]:=sl.strings[y]; y:=y+5; end;
y:=3; for x:= 1 to 10 do begin zeit_bis[x]:=sl.strings[y]; y:=y+5; end;
y:=4; for x:= 1 to 10 do begin programm[x]:=sl.strings[y]; y:=y+5; end;
end;
Procedure TForm1.ausgeben; var i,x : integer; begin Standart:='daten\Standard.pps';
if besetzt=false then begin ShellExecute(Application.Handle,'open',PCHAR(Standart),nil,nil,SW_shownormal); end;
for x := 1 to 10 do begin if ((datum_von[x]='break') and (besetzt=true)) then begin x2:=x; besetzt:=false; ShellExecute(Application.Handle,'open',PCHAR('close.bat'),nil,nil,SW_Hide); sleep(1000); ShellExecute(Application.Handle,'open',PCHAR(Standart),nil,nil,SW_shownormal); fullstring.caption:=('BREAK!'); end; end;
for x := 1 to 10 do begin if ((datum_von[x]='sofort') and (besetzt=false)) or ((datum.caption = datum_von[x]) and (zeit.caption = zeit_von[x]) and (besetzt=false)) then begin x2:=x; besetzt:=true; ShellExecute(Application.Handle,'open',PCHAR('close.bat'),nil,nil,SW_Hide); sleep(1000); ShellExecute(Application.Handle,'open',PCHAR('daten\'+Programm[x]),nil,nil,SW_shownormal); fullstring.caption:=(datum_von[x]+','+datum_bis[x]+','+zeit_von[x]+','+zeit_bis[x]+','+programm[x]); end; end;
if (datum.caption = datum_bis[x2]) and (zeit.caption = zeit_bis[x2]) and (besetzt=true) then begin ShellExecute(Application.Handle,'open',PCHAR('close.bat'),nil,nil,SW_Hide); besetzt:=false; zeilendeleter; end;
for i := 1 to 10 do begin memo2.lines.add('---Datensatz '+inttostr(i)+'---'); memo2.Lines.add('datum_von: '+datum_von[i]); memo2.Lines.add('datum_bis: '+datum_bis[i]); memo2.Lines.add('zeit_von: '+zeit_von[i]); memo2.Lines.add('zeit_bis: '+zeit_bis[i]); memo2.Lines.add('programm: '+programm[i]); memo2.lines.add(''); end; memo2.clear; end;
procedure TForm1.ausgabeTimer(Sender: TObject); begin ausgeben; end;
procedure TForm1.FormCreate(Sender: TObject); begin application.minimize; memo1.Clear; zeit.caption:=timetostr(now); datum.caption:=datetostr(now); x2:=0;
besetzt:=false; end;
procedure TForm1.FormDestroy(Sender: TObject); begin besetzt:=false; sl.free; liste.free; end;
procedure TForm1.eingabeTimer(Sender: TObject); begin einlesen; end;
procedure TForm1.zeitaktualTimer(Sender: TObject); begin zeit.caption:=timetostr(now); datum.caption:=datetostr(now); end;
procedure TForm1.Timer1Timer(Sender: TObject); begin Image1.Picture.Bitmap := GetScreenShot; Image1.Picture.Bitmap.SaveToFile('stream.bmp'); end;
end. |