[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by banned, 6 May 2007.

Thread Status:
Not open for further replies.
Page 245 of 489
  1. StealthMaster

    StealthMaster Member

    Joined:
    3 Dec 2008
    Messages:
    52
    Likes Received:
    11
    Reputations:
    0
    В принципе можно и в текстовых файлах (хотя зависит от типа информации, картинку в текст не впихнешь :)), но по-моему, гораздо удобнее использовать базу данных.

    А если хранишь текст в константах, то чтобы отредактировать какой либо текст, придется заново открыть исходник, внести изменения и откомпилировать программу. Долго и неудобно.
     
    #4881 StealthMaster, 9 Dec 2009
    Last edited: 9 Dec 2009
  2. transserg

    transserg Elder - Старейшина

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    возник вопрос как получить список всех модулей в системе (загруженных) через NtQuerySystemInformation немогу понять какую ей структуру надо
    Code:
    Procedure GetSystemInformation;
 var
   Temp: PSYSTEM_MODULE_INFORMATION;
   modin:PSYSTEM_MODULE_INFORMATION;
   ReturnLength: DWORD;
  I: integer;
  ou:integer;
 begin
  ou:=0;
   try
     ReturnLength := 0;
     if NtQuerySystemInformation(SystemModuleInformation,nil, 0, ReturnLength) <> STATUS_INFO_LENGTH_MISMATCH then
      Exit;
     if ReturnLength > 0 then
       begin
        GetMem(modin, ReturnLength);
        try
         if NtQuerySystemInformation(SystemModuleInformation,modin, ReturnLength, ReturnLength) = 0 then
         begin
           Temp := modin;
             repeat

              Form2.ListBox1.Items.Add(Temp^.aSysM.ImageName);
               Temp := Pointer(DWORD(Temp) + Temp^.aSysM.ModuleNameOffset);
               if Temp^.aSysM.ModuleNameOffset=0 then
                inc(ou);

             until ou=2;
         end;
       finally
         FreeMem(modin);
       end;
     end;
   finally
   end;
end;
 SYSTEM_MODULE= ^_SYSTEM_MODULE;
  _SYSTEM_MODULE= packed record
    Reserved:array[0..1] of  ULONG;
    Base:ULONG;
    Size:ULONG;
    Flags:ULONG;
    Index:ULONG;
    Unknown:ULONG;
    ModuleNameOffset:SHORT;
    ImageName:Array[0..256] of Char;
  end;
  PSYSTEM_MODULE_INFORMATION = ^SYSTEM_MODULE_INFORMATION;
  SYSTEM_MODULE_INFORMATION = packed record
   uCount:ULONG;
   aSysM:SYSTEM_MODULE;
  end;
    уже начался брутвфорс по перебору вариантов но это не дело...
     
    #4882 transserg, 9 Dec 2009
  3. DiHWO

    DiHWO Member

    Joined:
    23 Oct 2009
    Messages:
    93
    Likes Received:
    10
    Reputations:
    0
    StealthMaster, сэнк, вот если хранить в тхт, можно как - то спрятать тхт чтобы программа была одним файлом? просто прогу хочу на школьный конкурс, и какбе прога которая берет все из тхт файлов....ну неочень проффесионально\опрятно чтоли....
     
    #4883 DiHWO, 9 Dec 2009
  4. Thenno

    Thenno Member

    Joined:
    3 Jul 2009
    Messages:
    77
    Likes Received:
    21
    Reputations:
    0
    Почему неопрятно? Очень даже опрятно. Используй обычные текстовые файлы с собственным расширением. Я бы сделал так - исполнимый файл и рядом папку с базой этих самых файлов. Так будет удобнее и для расширения, и для реализации.
    Хотя самое красивое решение - это с базой данных, ИМХО.
     
    #4884 Thenno, 9 Dec 2009
  5. transserg

    transserg Elder - Старейшина

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    хм... исправил ошибку.... но заметил что ели делать через тул хелп модуль то выводит только модули своего процесса а не все что загруженный в системе.... с нт квери тож такая же трабла но оноа еще и драйвера.. но если выкинуть дрова то снова модули моего процесса так как получить модлуи DLL которые в данный момент загруженны в системе?
    Code:
    Procedure GetSystemInformation;
 var
   Temp: PSYSTEM_MODULE_INFORMATION;
   modin:PSYSTEM_MODULE_INFORMATION;
   ReturnLength: DWORD;
  I: integer;
  ou:integer;
 begin
  ou:=0;
   try
     ReturnLength := 0;
     if NtQuerySystemInformation(SystemModuleInformation,nil, 0, ReturnLength) <> STATUS_INFO_LENGTH_MISMATCH then
      Exit;
     if ReturnLength > 0 then
       begin
        GetMem(modin, ReturnLength);
        try
         if NtQuerySystemInformation(SystemModuleInformation,modin, ReturnLength, ReturnLength) = 0 then
         begin
           Temp := modin;
           for I := 0 to Temp^.uCount do
      //     if pos('.dll',String(Temp^.aSysM[i].ImageName))>0 then
             Form2.ListBox1.Items.Add(ExtractFileName(Temp^.aSysM[i].ImageName));
         end;
       finally
         FreeMem(modin);
       end;
     end;
   finally
   end;
end;
     
    #4885 transserg, 9 Dec 2009
  6. transserg

    transserg Elder - Старейшина

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    Pr0mo не мне список драйверов ненужен мне надо именно списко загруженных длл в системе =)
     
    #4886 transserg, 9 Dec 2009
  7. alwex

    alwex New Member

    Joined:
    14 Dec 2008
    Messages:
    137
    Likes Received:
    4
    Reputations:
    2
    всем привет, помогите решить тупую задачу...
    вывести 2 натуральных числа дробь каких наближает число Пи(3.14) с найбольшей точностью на Pascal...
     
    #4887 alwex, 9 Dec 2009
  8. Jajce

    Jajce New Member

    Joined:
    9 Dec 2009
    Messages:
    2
    Likes Received:
    0
    Reputations:
    0
    А как можно перевести эту прогу в графический режим с использованием СтрингГрида?
    Code:
    {$APPTYPE CONSOLE}

type
  TMatrix =
    record
      size: integer;
      data: array of array of integer;
    end;

var
  m: TMatrix;

function Minor(matrix: TMatrix; i,j: integer): TMatrix;
var
  a,b,a1,b1: integer;
begin
  a1 := -1;
  b1 := -1;
  result.size := matrix.size - 1;
  setlength(result.data, result.size, result.size);
  for a := 0 to result.size do
    begin
      if a=i then
        continue
      else
        inc(a1);
      for b := 0 to result.size do
        begin
          if b = j then
            continue
          else
            if b - b1 > 1 then
              inc(b1)
            else
              b1 := 0;
          result.data[a1,b1] := matrix.data[a,b];
      end;
    end;
end;

function Determ(matrix: TMatrix): integer;
var
  i: integer;
begin
  result := 0;
  if matrix.size = 2 then
    result := (matrix.data[0,0]*matrix.data[1,1]) - (matrix.data[0,1]*matrix.data[1,0])
  else
    begin
      for i := 0 to matrix.size - 1 do
        if odd(i+1) then
          result := result + matrix.data[i,0]*Determ(Minor(matrix,i,0))
        else
          result := result - matrix.data[i,0]*Determ(Minor(matrix,i,0));
    end;
end;

begin
  m.size := 3;
  setlength(m.data,3,3);
  m.data[0,0] := 2;
  m.data[0,1] := 4;
  m.data[0,2] := -1;
  m.data[1,0] := -1;
  m.data[1,1] := 3;
  m.data[1,2] := 2;
  m.data[2,0] := 3;
  m.data[2,1] := 2;
  m.data[2,2] := -2;
  writeln(Determ(m));
  readln;
end.
    Просто у самого не получается никак :confused:
     
    #4888 Jajce, 9 Dec 2009
  9. FindeR

    FindeR Elder - Старейшина

    Joined:
    15 Nov 2006
    Messages:
    623
    Likes Received:
    138
    Reputations:
    20
    Немного не пойму, как обратиться к динамично созданному объекту. А именно, к конкретному событию.
    К примеру, создали
    Code:
    Btn : array [0..100] of TButton;
Chk : array [0..100] of TCheckBox;
....
Btn[1] := TButton.create(self);
Chk[1] := TCheckBox.create(self);
Btn[2] := TButton.create(self);
Chk[2] := TCheckBox.create(self);
{и так сотня пар}
    Теперь требуется при нажатии Btn менять состояние Chk.

    Кто подскажет, как реализовать?
     
    #4889 FindeR, 9 Dec 2009
  10. Pr0mo

    Pr0mo Member

    Joined:
    26 Nov 2009
    Messages:
    29
    Likes Received:
    31
    Reputations:
    4


    Для этого тебе нужно создать свою процедуру, скажем:

    Code:
    ...
 procedure DynamicChkeBoxChange(Sender:TObject);
...


procedure TForm1.DynamicChkeBoxChange(Sender:TObject);
begin
  //Здесь все необходимые операции, например:
 chk[1].Checked:=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Btn[1] := TButton.create(self);
Chk[1] := TCheckBox.create(self);
chk[1].Parent:=Form1;
chk[1].Left:=200;
chk[1].Top:=200;
btn[1].Parent:=form1;
btn[1].OnClick:=TT; // Передаем событие TNotifyEvent
end;
    p.s.Есть и более разумнуе способы, но разобраться в них будет сложнее :)
     
    #4890 Pr0mo, 9 Dec 2009
  11. NTFF

    NTFF New Member

    Joined:
    9 Dec 2009
    Messages:
    23
    Likes Received:
    0
    Reputations:
    0
    Пожайлуста помогите с матрицей (ПАСКАЛЬ)

    в каждом столбце и каждой строке матрицы содержица строго по одному нулевому элементу. Перестановкой строк добиться расположение всех нулей по главной диагонали. В программе должна присутствовать проверка чтоб в строке был строго один ноль, в противном случае цикл не выполняться. матрица 5*5 пользователь сам ее вводит

    написать нужно в форме процедур

    есть то что питался сделать но что там не так не знаю

    Код:

    BEGIN
    clrscr;
    write('Vvedite matrix A: ');
    for i:=1 to 5 do
    for j:=1 to 5 do
    read (A [i,j]);

    for i:=1 to 5 do
    for etap:=1 to 5 do
    if (A[i,etap]=0)
    then findrow:=i;
    for j:=1 to 5 do
    begin
    c:=(A[etap,j]);
    A[etap,j]:=A[findrow,j];
    A[findrow,j]:=c;
    write (A[findrow,j]);
     
    #4891 NTFF, 9 Dec 2009
  12. Pr0mo

    Pr0mo Member

    Joined:
    26 Nov 2009
    Messages:
    29
    Likes Received:
    31
    Reputations:
    4
    Извиняюсь, не заметил сначала. Тогда есть вариант обратиться к каждому объекту, вызывающющему dll через его PID и на основе этого построить список загруженных библиотек в системе:

    Code:
    procedure GetAllDLL(var DLLList:TStringList);
var
 i:integer;
 tList:TStringList;
 ArrInfo:TLpModuleInfoArray;
begin
 tList:=TStringList.Create;
 ArrInfo:=GetAllProcessesInfo(false);
  for i:=0 to Length(ArrInfo)-1 do
   begin
     GetLoadedDLLList(tList,ArrInfo[i].ModulePID,[moIncludeHandle]);
     DLLList.AddStrings(tList);
   end;
   tList.Free;
end;

 // пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
 ntDLLList:TStringList;
begin
ntDLLList:=TStringList.Create;
GetAllDLL(ntDLLList);
ListBox1.Items:=ntDLLList;
ntDLLList.Free;
end;
    Однако для компиляции тебе понадобиться отдельный модуль : ProcUtilz (скачать)
     
    #4892 Pr0mo, 9 Dec 2009
    Last edited: 9 Dec 2009
  13. FindeR

    FindeR Elder - Старейшина

    Joined:
    15 Nov 2006
    Messages:
    623
    Likes Received:
    138
    Reputations:
    20
    И так сотня процедур? Или я что-то недопонял? ;)
    Да и неизвестно заранее количество объектов.
     
    #4893 FindeR, 9 Dec 2009
  14. Pr0mo

    Pr0mo Member

    Joined:
    26 Nov 2009
    Messages:
    29
    Likes Received:
    31
    Reputations:
    4
    Нет, конечно не сотня! Не для каждого же объекта писать отдельную процедуру или функцию. DynamicCheckBoxChange - это общая процедура, в которой можно описать необходимые действия, и затем присваивать ее определенным группам CheсkBox.
    А что касается неопределенности количества объектов, то тут прийдется заводить глобальную переменную, например, CheckBoxCount. И ссылаться в будущем на нее.

    Вообще говоря, такое динамическое создание объектов - это всегда рутинная, а иногда и бесполезная работа. Однако общий принцип таков.
     
    #4894 Pr0mo, 9 Dec 2009
  15. FindeR

    FindeR Elder - Старейшина

    Joined:
    15 Nov 2006
    Messages:
    623
    Likes Received:
    138
    Reputations:
    20
    А именно, как получить передать имя кнопки, которую нажали?
    Нажата Btn[1], сменился статус у Chk[1] и т.д.
    А не нажата любая Btn, а меняется статус у Chk[1]

    Вроде, понятно сформулировал.
     
    #4895 FindeR, 10 Dec 2009
  16. Pr0mo

    Pr0mo Member

    Joined:
    26 Nov 2009
    Messages:
    29
    Likes Received:
    31
    Reputations:
    4
    Тогда немного посложнее. В процедуре нужно ссылаться на указанный объект:

    Code:
    procedure TForm1.DynamicCheckBoxChange(Sender: TObject);
begin
 if (sender as TButton).Caption='123' then
  chk[1].Checked:=true;
end;
    Здесь Sender - это переменная, которая указывает на вызванный объект (нажатая кнопка). Таким образом, если у нажатой кнопки Caption = '123' то выполнится условие chk[1].Checked:=true;
     
    #4896 Pr0mo, 10 Dec 2009
  17. Thenno

    Thenno Member

    Joined:
    3 Jul 2009
    Messages:
    77
    Likes Received:
    21
    Reputations:
    0
    А необходимо переставлять эелементы в строке, или сами строки?
     
    #4897 Thenno, 10 Dec 2009
  18. StealthMaster

    StealthMaster Member

    Joined:
    3 Dec 2008
    Messages:
    52
    Likes Received:
    11
    Reputations:
    0

    Как я понял из сегодняшнего разговора, генерировать матрицу не нужно, а сортировка не выполняется вообще, если есть неправильная строка. Тогда вот код:

    Code:
    PROGRAM PMatrix;
uses
    Crt;

const
     N = 5;

Var
   Matrix:      Array [1..N,1..N] of byte;
   Indexes:     set of byte;
   counter:     byte;

function CheckMatrix: boolean;
var
   i, j:           byte;
begin
     CheckMatrix := false;
     Indexes := [];
     for i := 1 to N do
         begin
              counter := 0;
              for j := 1 to N do
                  begin
                       if (Matrix[i,j] = 0) then
                          begin
                               inc(counter);
                               if (j in Indexes) then
                                  exit;
                               Indexes := Indexes + [j];
                          end;
                  end;
              if (counter <> 1) then
                 exit;
         end;
     CheckMatrix := true;
end;


procedure ChangeLines(index1, index2: byte);
var
   tmp:         byte;
   i:           byte;
begin
     for i := 1 to N do
         begin
              tmp := Matrix[index1,i];
              Matrix[index1,i] := Matrix[index2,i];
              Matrix[index2,i] := tmp;
         end;

end;


procedure SortMatrix;
var
   i, j:        byte;
   tmp:         boolean;
begin
     for i := 1 to N do
         begin
              for j := 1 to N do
                  if (Matrix[i,j] = 0) then
                     begin
                          ChangeLines(i,j);
                          break;
                     end;
         end;
end;


procedure ShowMatrix;
var
   i, j:        byte;
begin
     for i := 1 to N do
         begin
              for j := 1 to N do
                  if (Matrix[i,j] < 10) then
                     write(' ', Matrix[i,j], ' ')
                  else
                      write(Matrix[i,j], ' ');
              writeln
         end;
end;


var
   i, j:        byte;
   chose:       char;
begin
     clrscr;
     Indexes := [];
     for i := 1 to N do
         for j := 1 to N do
             begin
                  write('Matrix[',i,',',j,'] = ');
                  readln(Matrix[i,j]);
             end;

     writeln;
     ShowMatrix;
     writeln;

     if CheckMatrix then
         SortMatrix;

     ShowMatrix;
     readln;
end.
     
    #4898 StealthMaster, 10 Dec 2009
    Last edited: 10 Dec 2009
    1 person likes this.
  19. Thenno

    Thenno Member

    Joined:
    3 Jul 2009
    Messages:
    77
    Likes Received:
    21
    Reputations:
    0
    Ех, опоздал, но все же выложу и свой вариант.
    Code:
    const n=5;

type
  matrix=array[1..n, 1..n] of integer;

procedure readmatrix (var mas:matrix);
  var
    i,j:integer;
  begin
    for i:=1 to n do
      for j:=1 to n do
        readln (mas[i,j]);
  end;

function provmatrix (var mas:matrix):boolean;
  var
    i,j:integer;
    k:integer;
  begin
    provmatrix:=false;
    for i:=1 to n do
      begin
        for j:=1 to n do
          begin
            if mas [i,j] = 0 then
              k:=k+1;
            if k>1 then
              exit;
          end;
        k:=0;
      end;
    provmatrix:=true;
  end;

procedure sortmatrix (var mas:matrix);
  var
    i,j:integer;
    index:integer;
    mas2:matrix;
  begin
    for i:=1 to n do
      for j:=1 to n do
        begin
          if mas[j,i]=0 then
            begin
              for index:=1 to n do
                mas2[i,index]:=mas[j,index];
            end;
        end;
    mas:=mas2;
  end;
  
procedure writematrix (mas:matrix);
  var
    i,j:integer;
  begin
    writeln;
    for i:=1 to n do
      begin
        for j:=1 to n do
          write (mas[i,j], ' ');
        writeln;
      end;

  end;

var
  m:matrix;
begin
  readmatrix (m);
  if provmatrix (m) = true then
    begin
      sortmatrix (m);
      writematrix (m);
    end;
  readln;
end.
    Вроде у StealthMaster'а заморочек побольше, у меня попробще для пониманию новичку, хотя, может быть, я и не прав.
     
    #4899 Thenno, 10 Dec 2009
  20. transserg

    transserg Elder - Старейшина

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    как можно замочить зомби процесс если его не берет TerminateProcess с правами отладчика....
     
    #4900 transserg, 10 Dec 2009
(You must log in or sign up to post here.)
Page 245 of 489
Thread Status:
Not open for further replies.
Language
English (US)
    ANTICHAT ™ © 2001-2027 Antichat Kft.