VPF::Помогите доработать прогу (dll и логи)

Bik

Дата 12.7.2006, 15:36 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 9
Регистрация: 1.7.2006

Репутация: нет
Всего: нет

Пришел сдавать преподу прогу, а он козе нечесный усложнил задание smile

Теперь надо:
1. Убрать из самой программы фун-цию Translit_ и реализовать её в виде DLL.
2. Добавить на форму кнопку истории, про нажатии на которую должно выводиться окно с логами совершавшихся действий типа:

Код


12/07/06 16:19 "Начало работы"
12/07/06 16:20 "Пользователь открыл файл"
12/07/06 16:23 "... сохранил"
12/07/06 16:25 "Использовал фунцию транслита"
12/07/06 16:30 "Завершил работу"
13/07/06 09:01 "Начало работы"

... и т.д. Логи должны записываться и храняться в файле в директории с программой.

Программа:
http://webfile.ru/1021862

comtat

Дата 12.7.2006, 16:37 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1310
Регистрация: 2.5.2006
Где: Россия, Казань

Репутация: 8
Всего: 71

С пунктом 2 по подробнее
В файл должны писаться логи программы ??

--------------------

Рожденный в СССР !!!
ExtJS - мой фреймворк

comtat

Дата 12.7.2006, 17:41 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1310
Регистрация: 2.5.2006
Где: Россия, Казань

Репутация: 8
Всего: 71

Вот чета типа того

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    CheckBox1: TCheckBox;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure logs(str:string);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function Translit_(s: string): string;
var
  i: integer;
  t: string;
begin
  for i := 1 to Length(s) do
    begin
      case s[i] of
        { rus -> eng }
        'é': t := t + 'q';
        'ö': t := t + 'w';
        'ó': t := t + 'e';
        'ê': t := t + 'r';
        'å': t := t + 't';
        'í': t := t + 'y';
        'ã': t := t + 'u';
        'ø': t := t + 'i';
        'ù': t := t + 'o';
        'ç': t := t + 'p';
        'õ': t := t + '[';
        'ú': t := t + ']';
        'ô': t := t + 'a';
        'û': t := t + 's';
        'â': t := t + 'd';
        'à': t := t + 'f';
        'ï': t := t + 'g';
        'ð': t := t + 'h';
        'î': t := t + 'j';
        'ë': t := t + 'k';
        'ä': t := t + 'l';
        'æ': t := t + ';';
        'ý': t := t + '''';
        'ÿ': t := t + 'z';
        '÷': t := t + 'x';
        'ñ': t := t + 'c';
        'ì': t := t + 'v';
        'è': t := t + 'b';
        'ò': t := t + 'n';
        'ü': t := t + 'm';
        'á': t := t + ',';
        'þ': t := t + '.';
        '.': t := t + '/';
        'É': T := T + 'Q';
        'Ö': T := T + 'W';
        'Ó': T := T + 'E';
        'Ê': T := T + 'R';
        'Å': T := T + 'T';
        'Í': T := T + 'Y';
        'Ã': T := T + 'U';
        'Ø': T := T + 'I';
        'Ù': T := T + 'O';
        'Ç': T := T + 'P';
        'Õ': T := T + '{';
        'Ú': T := T + '}';
        'Ô': T := T + 'A';
        'Û': T := T + 'S';
        'Â': T := T + 'D';
        'À': T := T + 'F';
        'Ï': T := T + 'G';
        'Ð': T := T + 'H';
        'Î': T := T + 'J';
        'Ë': T := T + 'K';
        'Ä': T := T + 'L';
        'Æ': T := T + ':';
        'Ý': T := T + '"';
        'ß': T := T + 'Z';
        '×': T := T + 'X';
        'Ñ': T := T + 'C';
        'Ì': T := T + 'V';
        'È': T := T + 'B';
        'Ò': T := T + 'N';
        'Ü': T := T + 'M';
        'Á': T := T + '<';
        'Þ': T := T + '>';
        ',': T := T + '?';
        { eng -> rus }
        'q': t := t + 'é';
        'w': t := t + 'ö';
        'e': t := t + 'ó';
        'r': t := t + 'ê';
        't': t := t + 'å';
        'y': t := t + 'í';
        'u': t := t + 'ã';
        'i': t := t + 'ø';
        'o': t := t + 'ù';
        'p': t := t + 'ç';
        '[': t := t + 'õ';
        ']': t := t + 'ú';
        'a': t := t + 'ô';
        's': t := t + 'û';
        'd': t := t + 'â';
        'f': t := t + 'à';
        'g': t := t + 'ï';
        'h': t := t + 'ð';
        'j': t := t + 'î';
        'k': t := t + 'ë';
        'l': t := t + 'ä';
        ';': t := t + 'æ';
        '''': t := t + 'ý';
        'z': t := t + 'ÿ';
        'x': t := t + '÷';
        'c': t := t + 'ñ';
        'v': t := t + 'ì';
        'b': t := t + 'è';
        'n': t := t + 'ò';
        'm': t := t + 'ü';
        '/': t := t + '.';
        'Q': T := T + 'É';
        'W': T := T + 'Ö';
        'E': T := T + 'Ó';
        'R': T := T + 'Ê';
        'T': T := T + 'Å';
        'Y': T := T + 'Í';
        'U': T := T + 'Ã';
        'I': T := T + 'Ø';
        'O': T := T + 'Ù';
        'P': T := T + 'Ç';
        '{': T := T + 'Õ';
        '}': T := T + 'Ú';
        'A': T := T + 'Ô';
        'S': T := T + 'Û';
        'D': T := T + 'Â';
        'F': T := T + 'À';
        'G': T := T + 'Ï';
        'H': T := T + 'Ð';
        'J': T := T + 'Î';
        'K': T := T + 'Ë';
        'L': T := T + 'Ä';
        ':': T := T + 'Æ';
        '"': T := T + 'Ý';
        'Z': T := T + 'ß';
        'X': T := T + '×';
        'C': T := T + 'Ñ';
        'V': T := T + 'Ì';
        'B': T := T + 'È';
        'N': T := T + 'Ò';
        'M': T := T + 'Ü';
        '<': T := T + 'Á';
        '>': T := T + 'Þ';
        '?': T := T + ',';
      else
        t := t + s[i];
      end;
    end;
  Result := t;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    begin
      logs('Пользователь открыл файл');
      Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
      CheckBox1.Checked := (GetFileAttributes(PChar(OpenDialog1.FileName)) and FILE_ATTRIBUTE_READONLY = 1);
    end;
Edit1.Text := OpenDialog1.FileName;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
SaveDialog1.FileName := OpenDialog1.FileName;
  if SaveDialog1.Execute then
    begin
      Memo1.Lines.SaveToFile(SaveDialog1.FileName);
      if CheckBox1.Checked then
        SetFileAttributes(PChar(SaveDialog1.FileName), GetFileAttributes(PChar(OpenDialog1.FileName)) or FILE_ATTRIBUTE_READONLY)
      else
       begin
        SetFileAttributes(PChar(SaveDialog1.FileName), GetFileAttributes(PChar(OpenDialog1.FileName)) and FILE_ATTRIBUTE_READONLY);
        logs('Пользователь сохранил в файл');
       end;
    end;
end;

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  i: Integer;
  s: string;
begin
  if ((Key = ord('T')) and (ssAlt in Shift)) then
  begin
    with Memo1 do
    begin
      i := SelStart;
      s := Translit_(SelText);
      SelText := s;
      SelStart := i;
      SelLength := Length(s);
    end;
  logs('Пользователь использовал транслит');
  end;
end;

procedure TForm1.logs(str:string);
var in_file: textFile;
    FileName,date,time: string;
begin
 FileName:='C:\log.txt';
 assignFile(in_file, FileName);
 if not (FileExists(FileName)) then rewrite(in_file)
 else
   Append(in_file);
 date:=DateToStr(Now());
 time:=TimeToStr(Now());
 Write(in_file, date); //запись даты
 Write(in_file, chr(9));
 Write(in_file, time); //запись времени
 Write(in_file, chr(9));
 WriteLn(in_file, str); //запись сообщения
 closeFile(in_file);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 logs('Пользотельзакрыл программу');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 logs('Пользователь открыл прорамму');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 logs('Пользователь открыл log файл');
 Memo1.Lines.LoadFromFile('C:\log.txt');
end;

end.

А с dll потерпи до завтра smile

--------------------

Рожденный в СССР !!!
ExtJS - мой фреймворк

Bik

Дата 12.7.2006, 21:20 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 9
Регистрация: 1.7.2006

Репутация: нет
Всего: нет

Спасибо, работает!
Жду длл...

Bik

Дата 14.7.2006, 08:26 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 9
Регистрация: 1.7.2006

Репутация: нет
Всего: нет

Необходимость отпала. Сам доделал и сдал вчера smile

comtat

Дата 14.7.2006, 08:48 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1310
Регистрация: 2.5.2006
Где: Россия, Казань

Репутация: 8
Всего: 71

Молодец, извини что не доделал
времени не вчера небыло smile

--------------------

Рожденный в СССР !!!
ExtJS - мой фреймворк

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »