frmmainunit.pas

防火墙DELPHI代码 防火墙DELPHI代码

        begin
          Reg.GetValueNames(Val);
          for I:=0 to Val.Count-1 do
          begin
            strName:=Val.Strings[I];
            //if trim(strName)='PSMAntiKeyLogger' then continue;
            strPath:=Reg.ReadString(strName);
            curListItem:=Items.Add;
            curListItem.Caption:=strName;
            GetMem(strEXEfree,strlen(Pchar(strPath))+1);
            strcopy(strEXEfree,Pchar(strPath));
            if strEXEfree[0]='"' then
              strEXE:=strEXEfree+1
            else
              strEXE:=strEXEfree;
            strEXE:=Pchar(trim(strlower(strEXE)));
            if StrRScan(strEXE,'"')<>nil then
              StrRScan(strEXE,'"')[0]:=#0
            else
              if pos('rundll32.exe',strEXE)=1 then
              begin
                strEXE:=strEXE+13;
                if Strpos(strEXE,'.dll')<>nil then StrPos(strEXE,'.dll')[4]:=#0;
              end
              else if Strpos(strEXE,'.exe ')<>nil then StrPos(strEXE,'.exe ')[4]:=#0;

            //ShowMessage(strEXE);
            if ImageList1.AddIcon(GetICON(strEXE))<>-1 then
              curListItem.ImageIndex:=ImageList1.Count-1
            else
              curListItem.ImageIndex:=0;

            if pos('_B',Location)>0 then
            begin
              curListItem.Checked:=False;
              curListItem.Data:=nil;
            end
            else
            begin
              curListItem.Checked:=True;
              curListItem.Data:=@curListItem;//Any poiter <> nil
            end;

            curListItem.SubItems.add(strPath);
            curListItem.SubItems.add(Location);
            curListItem.SubItems.add(strEXE);
            FreeMem(strEXEfree);
          end;
          Reg.CloseKey;
        end;
    finally
      Val.Free;
      Reg.Free;
    end;
  end;
End;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  WindowProc:=TrapMSG;//Change the WindowProc to User's proc.
  
  LoadStartupPrograms();
  ScanKeyboardFilterDriver();
  ScanSystemINI('System.ini');
  ScanSystemINI('Win.ini');

  if (GetVersion() >= $80000000) then //Win9x
  begin
    cmdServiceMan.Enabled:=False;
    ListView2.Items.Add.SubItems.Add('For Windows NT/2000/XP only!');
    ListView2.Enabled:=false;
  end
  else
  begin
    if not ServiceGetList('',SERVICE_WIN32,SERVICE_STATE_ALL,ListView2) then
      ListView2.Items.Add.SubItems.Add('Can not get Service List!');
  end;
end;

procedure TfrmMain.ListView1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var LI:TListItem;
begin
  if ListView1.Items[0].SubItems.Count>0 then
  begin
    LI:=ListView1.GetItemAt(x,y);
    if LI<>nil then
    begin
      if (LI.Checked) and (LI.Data=nil) then
      begin
        ListView1.Selected:=LI;
        ChangeReg(LI,false);
        LI.Data:=@LI//Any poiter <> nil
      end
      else  if (not LI.Checked) and (LI.Data<>nil) then
      begin
        ListView1.Selected:=LI;
        ChangeReg(LI,false);
        LI.Data:=nil;
      end
    end;
  end;
end;

Procedure TfrmMain.ChangeReg(LI: TListItem; booDel:Boolean);
var
  reg: Tregistry;
  writePath: String;
  delPath: String;
begin
  Reg:=TRegistry.Create;
  try
    if (LI.SubItems[1]='HKCU')or(LI.SubItems[1]='HKCU_B')or(LI.SubItems[1]='HKCU_S')or(LI.SubItems[1]='HKCU_S_B') then
      Reg.RootKey:=HKEY_CURRENT_USER
    else
      Reg.RootKey:=HKEY_LOCAL_MACHINE;

    if LI.Checked then
      if pos('_S',LI.SubItems[1])>0 then
      begin
        writePath:='Software\Microsoft\Windows\CurrentVersion\RunServices';
        delPath:='Software\Microsoft\Windows\CurrentVersion\RunServices_Bak';
      end
      else
      begin
        writePath:='Software\Microsoft\Windows\CurrentVersion\Run';
        delPath:='Software\Microsoft\Windows\CurrentVersion\Run_Bak';
      end
    else
      if pos('_S',LI.SubItems[1])>0 then
      begin
        writePath:='Software\Microsoft\Windows\CurrentVersion\RunServices_Bak';
        delPath:='Software\Microsoft\Windows\CurrentVersion\RunServices';
      end
      else
      begin
        writePath:='Software\Microsoft\Windows\CurrentVersion\Run_Bak';
        delPath:='Software\Microsoft\Windows\CurrentVersion\Run';
      end;

      if Reg.OpenKey(writePath,true) then
      begin
        if not booDel then
          Reg.WriteString(LI.caption,LI.SubItems[0])
        else
          Reg.DeleteValue(LI.caption);
        Reg.CloseKey;

        if Reg.OpenKey(delPath,false) then
        begin
          Reg.DeleteValue(LI.caption);
          Reg.CloseKey;
        end;
        if booDel then LI.Delete;
      end;
  finally
    reg.Free;
  end;
end;

procedure TfrmMain.PopupMenu1Popup(Sender: TObject);
begin
  if (PageControl.TabIndex=0) then
    if ListView1.Focused then
    begin
      if (ListView1.Selected=nil) then
      begin
        mnuInf.Enabled:=False;
        mnuDel.Enabled:=False
      end
      else
      begin
        mnuInf.Enabled:=True;
        mnuDel.Enabled:=true;
      end
    end
    else
    begin
      if (ListView1_2.Selected=nil) then
      begin
        mnuInf.Enabled:=False;
        mnuDel.Enabled:=False
      end
      else
      begin
        mnuInf.Enabled:=True;
        mnuDel.Enabled:=true;
      end
    end
  else if (PageControl.TabIndex=2) then
  begin
    //mnuDel.Enabled:=False;
    if (ListView3.Selected<>nil)and (ListView3.Selected.SubItems.Count>0 ) then
    begin
      mnuDel.Enabled:=True;
      mnuInf.Enabled:=True;
    end
    else
    begin
      mnuDel.Enabled:=false;
      mnuInf.Enabled:=False;
    end;
  end;

end;

procedure TfrmMain.mnuDelClick(Sender: TObject);
begin
  if ListView1.Focused then
  begin
    if ListView1.Selected<>nil then
    if MessageBox(Handle,Pchar('Remove [' + ListView1.Selected.Caption + '] from this list?'),'This action can not be undone!',MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2)=IDYES then
      ChangeReg(ListView1.Selected,true);
  end
  else if ListView1_2.Focused then
  begin
    if MessageBox(Handle,Pchar('Remove [' + ListView1_2.Selected.Caption + '] from this list?'),'This action can not be undone!',MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2)=IDYES then
    begin
      if DeleteFile(ListView1_2.Selected.SubItems[2]) then
        ListView1_2.Selected.Delete;
    end;
  end
  else if ListView3.Focused then DelKBf;
end;

procedure TfrmMain.mnuInfClick(Sender: TObject);
var
  sei: TShellExecuteInfo;
begin
  if PageControl.TabIndex=0 then
  begin
    if ListView1.Focused then
    begin
      if ListView1.Selected<>nil then
      //if FileExists(trim(ListView1.Selected.SubItems[2])) then
      begin
        FillChar(sei, SizeOf(sei), 0);
        sei.cbSize := SizeOf(sei);
        sei.lpFile := PChar(ListView1.Selected.SubItems[2]);
        sei.lpVerb := 'properties';
        sei.fMask  := SEE_MASK_INVOKEIDLIST;
        sei.Wnd:=Handle;
        ShellExecuteEx(@sei);
      end
      //else ShowMessage('File not found!')
    end
    else
    begin
      if ListView1_2.Selected<>nil then
//      if FileExists(trim(ListView1_2.Selected.SubItems[0])) then
      begin
        FillChar(sei, SizeOf(sei), 0);
        sei.cbSize := SizeOf(sei);
        sei.lpFile := PChar(ListView1_2.Selected.SubItems[0]);
        sei.lpVerb := 'properties';
        sei.fMask  := SEE_MASK_INVOKEIDLIST;
        sei.Wnd:=Handle;
        ShellExecuteEx(@sei);
      end
//      else ShowMessage('File not found!')
    end;
    //ShowMessage(sei.lpFile);
  end
  else if PageControl.TabIndex=2 then
  begin
    if ListView3.Selected<>nil then
//    if FileExists(trim(ListView3.Selected.SubItems[0])) then
    begin
      FillChar(sei, SizeOf(sei), 0);
      sei.cbSize := SizeOf(sei);
      sei.lpFile := PChar(ListView3.Selected.SubItems[0]);
      sei.lpVerb := 'properties';
      sei.fMask  := SEE_MASK_INVOKEIDLIST;
      sei.Wnd:=Handle;
      ShellExecuteEx(@sei);
    end
//    else ShowMessage('File not found!')
  end;
end;

procedure TfrmMain.ListView3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LI:TListItem;
  newF:string;
begin
  exit;//20031210
  if ListView3.Items[0].SubItems.Count<=0 then exit;
  LI:=ListView3.GetItemAt(x,y);
  if LI<>nil then
  begin
    if not FileExists(LI.SubItems[0]) then
    begin
      LI.Checked:=False;
      exit;
    end;
    newF:='';
    if (LI.Checked) and (LI.Data=nil) then
    begin
      newF:=LI.SubItems[0];
      newF[strlen(Pchar(newF))-3]:=#0;
      newF:=Pchar(newF);
      LI.Data:=@LI//Any poiter <> nil
    end
    else  if (not LI.Checked) and (LI.Data<>nil) then
    begin
      newF:=LI.SubItems[0] + '.del';
      LI.Data:=nil;
    end;
    if newF<>'' then
    begin
      if not RenameFile(LI.SubItems[0], newF) then
        LI.Checked:= not LI.Checked
      else
        LI.SubItems[0]:= newF;
    end;
   end;
end;

procedure TfrmMain.ListView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Key:=0;
end;

procedure TfrmMain.ListView3KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Key:=0;
end;

Procedure TfrmMain.ScanSystemINI(iniFN:string);
var
  F1: TextFile;
  St: String;
  curListItem: TListItem;
  lv:TlistView;
  iniF: array[1..MAX_PATH] of char;
begin
  if GetWindowsDirectory(Pchar(@iniF),MAX_PATH)=0 then
  begin
    MessageBox(Handle,'Error get Windows Dir!','Scan INI files...',MB_ICONEXCLAMATION);
    exit;
  end;

  if iniFN='System.ini' then lv:=ListView4 else lv:=ListView5;
  lv.Clear;

  AssignFile(F1, Pchar(@iniF) + '\' + iniFN);
  Reset(F1);
  while not Eof(F1) do
  begin
    Readln(F1, St);
    st:=strlower(Pchar(trim(st)));
    if (Pos('load',Pchar(st))=1) or (Pos('run',Pchar(st))=1) or (Pos('device',Pchar(st))=1)then
    begin
      curListItem:=lv.Items.Add;
      curListItem.Caption:=st;
      curListItem.Checked:=True;
    end
    else if (Pos(';load',Pchar(st))=1) or (Pos(';run',Pchar(st))=1) or (Pos(';device',Pchar(st))=1)then
    begin
      curListItem:=lv.Items.Add;
      curListItem.Caption:=st;
      curListItem.Checked:=False;
    end
  end;
  CloseFile(F1);
  if lv.Items.Count=0 then
  begin
    lv.Checkboxes:=False;
    lv.Items.Add.Caption:='No additional driver found!';
  end;
end;

procedure TfrmMain.ListView4MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LI:TListItem;
  oldIndex: Integer;
begin
  LI:=ListView4.GetItemAt(x,y);
  if LI<>nil then
  begin
    if (LI.Checked) and (LI.Caption[1]=';') then
    begin
      ListView4.Selected:=LI;
      oldIndex:=ListView4.ItemIndex;
      ChangeLine('System.ini',Pchar(LI.Caption),Pchar(LI.Caption)+1);
      ScanSystemINI('System.ini');
      ListView4.ItemIndex:=oldIndex;