Отправляет email-рассылки с помощью сервиса Sendsay

Программирование на Delphi

  Все выпуски  

Программирование на Delphi (выпуск 42)


Программирование на DELPHI
Выпуск #42 (26 февраля 2006 г.) 

Разделы сайта:

Новости сайта
Система "Эксперт"
Вопросы и Ответы
Отправить вопрос
Файловый архив
Статьи
Компоненты
Plug-in's
Документация
Исходники
Изображения
Игры
Программы
Форум
Гостевая книга
F.A.Q.
Архив рассылки
Каталог сайтов
Обратная связь
Хостинг



Связь:

Администратор
Система "Эксперт"
Информация

Доброго времени суток, уважаемые читатели!

Не думаю, что случится что-то страшное, если я скажу, что на сайте новых файлов не появилось. На это есть свои причины. В данный момент идёт обновление всего сайтового движка и делаются нововведения. К примеру, скоро появится совершенно новая система регистрации, будет переработан раздел "Статьи", слегка ускорится загрузка сайта, появятся новые опросы (их будет много, как и должно быть), ну и многое другое. Большая часть из этого уже готова, и скоро появится на сайте.
В связи с измененями в структуре сайта, регистрация пользователей временно остановлена.
Также на сайте планируется открыть... Впрочем, пока что не буду торопиться и открывать тайну - позже сами всё увидите :-)

Обратите внимание на таблицу со статистической информацией. Думаю, новый её вариант многим покажется интересным. Обновляться эта таблица будет в каждом выпуске.

На этом вкратце всё. Ну вот, как всегда - полстраницы написал, а ничего толком не сказал... Приятного чтения!

Внимание! Вопросы и ответы для следующего выпуска рассылки принимаются до 04.03.2006 18:00.

В интернет-магазине для программистов, появился новый диск Borland Developer Studio 2006. Спешите приобрести данный DVD диск всего за 300 руб. Доставка осуществляется по всей России. Рекомендуем Вам приобрести следующие диски:

E-book - библиотека программиста (150 учебников по программированию)
.NET программирование
SDK, DDK и инсталяторы
и
DVD - Delphi

Также в продаже имеется Microsoft Visual Studio 2005.

Сайт "Программирование на Delphi": http://www.delphi.int.ru/ Форум нашего сайта: http://www.delphi.int.ru/forum/

До встречи!

Разделы рассылки:

Авторское слово
Новые вопросы
Ответы на вопросы
Статья по Delphi
Файловый архив
Друзья
Юмор


Количество читателей рассылки: 4087.


Подписка на рассылку:

Программирование на DELPHI


Подписаться почтой

Лидеры по количеству баллов:

Место
Имя
Баллы
Статус
1
Ermakova Dasha
320
Специалист
2
Dron
318
Специалист
3
Feniks
296
Практикант
4
Садовников Владимир
288
Практикант
5
Матвеев И.В.
246
Практикант
6
Iron Monk
200
Практикант
7
Антон Трапезников
153
Практикант
8
Лучников А.И.
127
Студент
9
Ершов Денис
125
Студент
10
mvp
125
Студент
11
midav.land.ru
118
Студент
12
PVS
103
Студент
13
Yurchik
100
Студент
14
VeroLom
90
Эксперт: 10-ый класс
15
Igor Danilevych
86
Эксперт: 9-ый класс

Некоторая статистическая информация (по системе "Эксперт"):

Статистика
На текущий момент
В прошлом выпуске
Динамика
Количество участников:
153
151
+2
Общее количество баллов:
4762
4571
+191 (!)
Средний балл:
31
30
+1
Максимальный балл:
320
320
-
Минимальный балл:
3
3
-
Адресов в зоне .RU:
112
112
-

Статусы экспертов и их возможности:

Статус
Необходимое кол-во баллов
Прикрепление файлов
Форматирование текста
Посетитель
0
нет
нет
Эксперт 1-го класса
1
нет
нет
Эксперт 2-го класса
10
нет
нет
Эксперт 3-го класса
20
нет
нет
Эксперт 4-го класса
30
нет
нет
Эксперт 5-го класса
40
нет
нет
Эксперт 6-го класса
50
до 250 Кб
нет
Эксперт 7-го класса
60
до 250 Кб
нет
Эксперт 8-го класса
70
до 250 Кб
нет
Эксперт 9-го класса
80
до 250 Кб
нет
Эксперт 10-го класса
90
до 250 Кб
нет
Студент
100
до 250 Кб
нет
Практикант
150
до 250 Кб
нет
Специалист
300
до 250 Кб
да
Профессионал
500
до 1 Мб
да
Профессор
800
до 1 Мб
да
Академик
1000
до 1 Мб
да

Примечание: Под форматированием текста понимается возможность оформлять ответы с использованием html-тегов.

Если Вы хотите, чтобы Вашего имени (ника) не было в данной таблице, отправьте письмо по этой ссылке с зарегистрированного у нас адреса. В теле письма, пожалуйста, укажите причину удаления имени из таблицы. Нам важно ваше мнение.


Основные правила нашей рассылки:

1. Не присылайте ответов на вопросы вроде "да я не знаю" или "да/нет". Такие ответы не публикуются.
2. Вопросы, не касающиеся Delphi, не принимаются (для этого существуют другие рассылки).
3. Запрещено присылать вложенные файлы, объёмом выше установленного ограничения (ограничения указаны в правилах).
4. Не изменяйте тем присылаемых писем. Письма с "неправильными" темами не обрабатываются! Используйте текстовый (не HTML) формат писем. HTML-теги применяйте только в том случае, если Вы уже достигли статуса, где это разрешено (см. правила).
5. Запрещено задавать вопросы, содержащие два (или несколько) вопросов разной тематики. Каждый из таких вопросов должен быть оформлен отдельным письмом.

Задать вопрос в рассылку   |   Задать вопрос с помощью web-формы   |   Система "Эксперт"


Новые вопросы.

Вопрос #242 (автор вопроса: Zeon; вопрос отправлен: 11.02.2006 22:29):

Как подсчитать количество входящего/исходящего трафика с заданного IP адреса?  [Ответить на вопрос]

Вопрос #243 (автор вопроса: Ilia; вопрос отправлен: 11.02.2006 23:04):

Ребят, подскажите, как при запуске ехе-шника сделать его доступным для редактирования (если стоит пометка только чтение) и добавить некоторую информацию в реестр виндоуса и в сам ехе-шник? Как пишется код и где?  [Ответить на вопрос]

Вопрос #244 (автор вопроса: Naj; вопрос отправлен: 12.02.2006 17:23):

Как называется и как используется функция в Delphi, которая позволяет не писать например: абвг аБвг Абвг абВг абвГ АБвг АбВГ и т.д. Чтобы это сразу воспринималось программой как одно и то же слово?  [Ответить на вопрос]

Вопрос #245 (автор вопроса: Evgen Sandrong; вопрос отправлен: 13.02.2006 00:04):

Доброго времени суток! Я познакомился с Делфи буквально пару дней назад. Поэтому, если что не так, то прошу извинить. Вопрос у меня такой: как с помощью Делфи можно выполнить перезагрузку Windows XP? Заранее спасибо.  [Ответить на вопрос]

Вопрос #246 (автор вопроса: Zhenja; вопрос отправлен: 13.02.2006 11:39):

Доброго времени суток! У меня следующий вопрос: есть программа, которая выводит звуковой сигнал по заданному расписанию. Проблема в том, что необходимо определить количество звуковых карточек и програмным путем выводить звуковые потоки из форматов *.wav *.mp3. Пытаюсь реализовать задачу на компоненте FilterGraph из библиотеки DSPACK234 (т.к. мне необходим бесплатный компонент). Но готов принять любой пример на любом компоненте или WinAPI, реализующий данную задачу. Зарание спасибо.  [Ответить на вопрос]

Вопрос #247 (автор вопроса: Ludmila; вопрос отправлен: 13.02.2006 14:18):

Как найти и установить в RaveReport свойства MasterDataView и MasterKey для подчиненной полосы данных? Я этих свойств просто не вижу. DetailKey - без проблем. Может не там ищу?  [Ответить на вопрос]

Вопрос #248 (автор вопроса: Антон; вопрос отправлен: 14.02.2006 15:22):

Как сделать подобную интеграцию в Explorer, как у Mobile Phone Manager и Nokia PC Suite, т.е. добавить новый диск в Мой компьютер и написать сам плагин?  [Ответить на вопрос]

Вопрос #249 (автор вопроса: Zerg; вопрос отправлен: 14.02.2006 22:09):

Уважаемые эксперты, подскажите как дернуть фрейм из AVI файла? В статье http://www.excode.ru/art2846.html все работает, если кодек DivX, а если Xvid то не пашет.  [Ответить на вопрос]

Вопрос #250 (автор вопроса: Wegga; вопрос отправлен: 16.02.2006 11:49):

Как в DataSet найти запись, которая была добавлена последней? Или найти значение максималького ключа?  [Ответить на вопрос]

Вопрос #251 (автор вопроса: Stavskiys; вопрос отправлен: 20.02.2006 13:58):

Нужно передать данные из своего приложения в интернет (скрипту), который в последствии обработает эти данные. Скрипт получает данные из $_POST["x"]. Как организовать передачу, без использования WebBrowser и HTML? Допустим, данные вводятся в Memo1. Спасибо.  [Ответить на вопрос]


Ответы на вопросы.

Вопрос #231:
Здравствуйте уважаемые специалисты по Delphi, подскажите начинающему программисту. База Oracle, я не могу связать поле MEMO в Дельфи с полем типа BLOB в Oracle. Заранее благодарен.

1. [Отвечает: Антон Трапезников (статус: Практикант), 13.02.2006 12:25]: Воспользуйтесь типом TBlobStream. Например:

procedure GetMemo;
var  
  MemoStream: TBlobStream;
begin  
  MemoStream:= Nil;
  with DataModule1.Table1 do
    try  
      Open;
      First;
      MemoStream:= TBlobStream.Create( Table1Memo, bmread );
      Richedit1.PlainText := False;
      Richedit1.Lines.Loadfromstream(MemoStream);
    finally  
      MemoStream.Free;
      Close;
    end;  
end;  

procedure PutMemo;
var  
  MemoStream: TBlobStream;
begin  
  MemoStream:= Nil;
  with DataModule1.Table1 do
    try  
      Open;
      First;
      Edit;
      MemoStream:= TBlobStream.Create( Table1Memo, bmwrite );
      Richedit1.PlainText := False;
      Richedit1.Lines.Savetostream(MemoStream);
      Post;
    finally  
      MemoStream.Free;
      Close;
    end;  
end;  

Оценка за ответ: 5.

Вопрос #232:
Подскажите, как подключиться к реестру на удаленной машине и считать из него ключи?

1. [Отвечает: Zeon (статус: Эксперт: 5-ый класс), 11.02.2006 20:55]: Прийдётся писать клиент-сервер. Серверная часть будет работать слокальным реестром удалённой машины и обмениваться необходимымиданными с клиентской частью. Реализовать такое чудо проще всего на сокетах.

Оценка за ответ: 4.

2. [Отвечает: Садовников Владимир (статус: Практикант), 11.02.2006 22:28]:Думаю, что здесь достаточно простым решением будет написать свойклиент-сервер, если есть возможность установить его на удалённоймашине. На удалённой машине устанавливается сервер, на твоей - клиент.Вешаешь свой протокол обмена - и всё, подавая с клиента запросы,получаешь ответы.

Оценка за ответ: 4.

3. [Отвечает: Матвеев И.В. (статус: Практикант), 12.02.2006 11:33]: Необходимоподключитьсякрееструспомощьюфункции RegConnectRegistry, Вы получите ключ HKEY, который потом нужнопозставлять в функции работы с реестром. Естественно необходимо иметьввиду, что у Вас должны быть соответствующие права.

Этот пример показывает получение строки версии OCизключа HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion - ProductName для компьютера \\server.

// Подключение к удаленному реестру
function RegConnect(Machine: string; RootKey: HKEY; var RemoteKey: HKEY): Boolean;
begin
Result := (RegConnectRegistry(PChar(Machine), RootKey, RemoteKey) = ERROR_SUCCESS);
end;

// Отключение
function RegDisconnect(RemoteKey: HKEY): Boolean;
begin
Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);
end;

// Чтение из строки из реестра
function RegQueryStr(RootKey: HKEY; Key, Name: string;
  Success: PBoolean = nil): string;
var
  Handle: HKEY;
  Res: LongInt;
  DataType, DataSize: DWORD;
begin
  if Assigned(Success) then
    Success^ := False;
  Res := RegOpenKeyEx(RootKey, PChar(Key), 0, KEY_QUERY_VALUE, Handle);
  if Res <> ERROR_SUCCESS then
    Exit;
  Res := RegQueryValueEx(Handle, PChar(Name), nil, @DataType, nil, @DataSize);
  if (Res <> ERROR_SUCCESS) or (Datatype <> REG_SZ) then
  begin
    RegCloseKey(Handle);
    Exit;
  end;
  SetString(Result, nil, DataSize - 1);
  Res := RegQueryValueEx(Handle, PChar(Name), nil, @DataType,
    PByte(@Result[1]), @DataSize);
  if Assigned(Success) then
    Success^ := Res = ERROR_SUCCESS;
  RegCloseKey(Handle);
end;

// Получение версии Windows из
// HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion - ProductName
procedure TForm1.Button1Click(Sender: TObject);
var
usersKey : HKEY;
Buf      : Pointer;
BufSize  : Integer;
begin
try
  if not RegConnect('\\server', HKEY_LOCAL_MACHINE, usersKey) then
    MessageBox(Handle, 'Не удалось подключиться к удаленному реестру', 'Ошибка', MB_OK or MB_ICONERROR)
     else
       begin
        ShowMessage(RegQueryStr(usersKey, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'ProductName'));
       end;
finally
   if usersKey <> 0 then RegDisconnect(usersKey);
end;
end;// Подключение к удаленному реестру
function RegConnect(Machine: string; RootKey: HKEY; var RemoteKey: HKEY): Boolean;
begin
Result := (RegConnectRegistry(PChar(Machine), RootKey, RemoteKey) = ERROR_SUCCESS);
end;

// Отключение
function RegDisconnect(RemoteKey: HKEY): Boolean;
begin
Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);
end;

// Чтение из строки из реестра
function RegQueryStr(RootKey: HKEY; Key, Name: string;
  Success: PBoolean = nil): string;
var
  Handle: HKEY;
  Res: LongInt;
  DataType, DataSize: DWORD;
begin
  if Assigned(Success) then
    Success^ := False;
  Res := RegOpenKeyEx(RootKey, PChar(Key), 0, KEY_QUERY_VALUE, Handle);
  if Res <> ERROR_SUCCESS then
    Exit;
  Res := RegQueryValueEx(Handle, PChar(Name), nil, @DataType, nil, @DataSize);
  if (Res <> ERROR_SUCCESS) or (Datatype <> REG_SZ) then
  begin
    RegCloseKey(Handle);
    Exit;
  end;
  SetString(Result, nil, DataSize - 1);
  Res := RegQueryValueEx(Handle, PChar(Name), nil, @DataType,
    PByte(@Result[1]), @DataSize);
  if Assigned(Success) then
    Success^ := Res = ERROR_SUCCESS;
  RegCloseKey(Handle);
end;

// Получение версии Windows из
// HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion - ProductName
procedure TForm1.Button1Click(Sender: TObject);
var
usersKey : HKEY;
Buf      : Pointer;
BufSize  : Integer;
begin
try
  if not RegConnect('\\server', HKEY_LOCAL_MACHINE, usersKey) then
    MessageBox(Handle, 'Не удалось подключиться к удаленному реестру', 'Ошибка', MB_OK or MB_ICONERROR)
     else
       begin
        ShowMessage(RegQueryStr(usersKey, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'ProductName'));
       end;
finally
   if usersKey <> 0 then RegDisconnect(usersKey);
end;
end;

Оценка за ответ: 5.

4. [Отвечает: Антон Трапезников (статус: Практикант), 16.02.2006 11:00]: Для удаленного управления реестром в винде есть одноименная служба, но для этого надо зайти на комп (удаленно) с тем же логином и паролем, что и у админа + должны быть включены: служба удаленного вызова процедур, служба удаленного управления реестром. Вероятно в винде есть пара недокументированных возможностей для программирования подобных служб, но я в MSDN нашел только одну - RegConnectRegistry.

LONG RegConnectRegistry(
LPCTSTR lpMachineName,
HKEY hKey,
PHKEY phkResult
);

lpMachineName
[in] Pointer to a null-terminated string specifying the name of the remote computer. The string has the following form:
\\computername
The caller must have access to the remote computer or the function fails.
If this parameter is NULL, the local computer name is used.
hKey
[in] Predefined registry handle. This parameter can be one of the following predefined keys on the remote computer.
HKEY_CLASSES_ROOT
HKEY_CURRENT_USER
HKEY_LOCAL_MACHINE
HKEY_PERFORMANCE_DATA
HKEY_USERS

Можно пойти другим путем и написать прогу вроде систем удаленного администрирования или трояна, где серверная часть устанавливается на удаленной машине и запускается вместе с виндой. В задачи серверной части входит прием команд с клиентской проги (которая стоит у Вас) и, естественно, их выполнение. Для работы с реестром в Win32 API предусмотрено несколько функций:

RegConnectRegistry
RegCreateKey
RegCreateKeyEx
RegDeleteKey
RegDeleteValue
RegEnumKey
RegEnumKeyEx
RegEnumValue
RegLoadKey
RegOpenKey
RegOpenKeyEx
RegQueryInfoKey
RegQueryMultipleValues
RegQueryValue
RegQueryValueEx
RegReplaceKey
RegSaveKey
RegSetValue
RegSetValueEx
RegUnLoadKey

Оценка за ответ: 5.

Вопрос #233:
Здравствуйте уважаемые эксперты! Подскажите, как написать простейший Клиент и Сервер на Delphi? Заранее спасибо!

1. [Отвечает: Zeon (статус: Эксперт: 5-ый класс), 11.02.2006 21:03]: Вот например очень простой пример простейший пример чата на сокетах:

Клиент:

unit Unit1;

interface

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

type
  TClientForm = class(TForm)
    ConnectButton: TButton;
    DisConnectButton: TButton;
    ExitButton: TButton;
    SendTextMemo: TMemo;
    GetTextMemo: TMemo;
    ClientSocket: TClientSocket;
    SrvLabel: TLabel;
    SrvEdit: TEdit;
    procedure ConnectButtonClick(Sender: TObject);
    procedure DisConnectButtonClick(Sender: TObject);
    procedure ExitButtonClick(Sender: TObject);
    procedure SendTextMemoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  ClientForm: TClientForm;
  Server: String;

implementation

{$R *.dfm}

procedure TClientForm.ConnectButtonClick(Sender: TObject);
begin
   if ClientSocket.Active then ClientSocket.Active := False;
   begin
      Server := SrvEdit.Text;
      if Length(Server) > 0 then
      begin
         ClientSocket.Host := Server;
         ClientSocket.Active := True;
      end;
   end;
end;

procedure TClientForm.DisConnectButtonClick(Sender: TObject);
begin
   ClientSocket.Active := False;
end;

procedure TClientForm.ExitButtonClick(Sender: TObject);
begin
   ClientSocket.Close;
   Application.Terminate;
end;

procedure TClientForm.SendTextMemoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if Key = VK_Return then
   ClientSocket.Socket.SendText(SendTextMemo.Lines[SendTextMemo.Lines.Count - 1]);
end;

procedure TClientForm.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   GetTextMemo.Lines.Add(Socket.ReceiveText);
end;

procedure TClientForm.ClientSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   GetTextMemo.Lines.Add('Error connecting to : ' + Server);
   ErrorCode := 0;
end;
end.

Сервер:

unit Unit1;

interface

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

type
  TServerForm = class(TForm)
    DisConnectButton: TButton;
    ExitButton: TButton;
    SendTextMemo: TMemo;
    GetTextMemo: TMemo;
    ServerSocket: TServerSocket;
    procedure FormActivate(Sender: TObject);
    procedure ExitButtonClick(Sender: TObject);
    procedure SendTextMemoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DisConnectButtonClick(Sender: TObject);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  ServerForm: TServerForm;
  Server: String;

implementation

{$R *.dfm}

procedure TServerForm.FormActivate(Sender: TObject);
begin
   ServerSocket.Active := True;
end;

procedure TServerForm.ExitButtonClick(Sender: TObject);
begin
   ServerSocket.Close;
   Application.Terminate;
end;

procedure TServerForm.SendTextMemoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if Key = VK_Return then
   ServerSocket.Socket.Connections[0].SendText(SendTextMemo.Lines[SendTextMemo.Lines.Count - 1]);
end;

procedure TServerForm.DisConnectButtonClick(Sender: TObject);
begin
   ServerSocket.Active := False;
end;

procedure TServerForm.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   GetTextMemo.Lines.Add(Socket.ReceiveText);
end;

procedure TServerForm.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   GetTextMemo.Lines.Clear;
   ShowMessage('A?a?eia caeiiaeoeeanu');
end;

procedure TServerForm.ServerSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   GetTextMemo.Lines.Add('Error connecting to : ' + Server);
   ErrorCode := 0;
end;

end.

И не забуть кинуть на форму соответствующие компоненты. А еще можешь посмотреть стандартный пример в Delphi: <Delphi dir>\Demos\Internet\Chat.

Оценка за ответ: 5.

2. [Отвечает: Садовников Владимир (статус: Практикант), 11.02.2006 22:26]: Используй стандартные компоненты. Посмотри на сайте http://www.delphi.int.ru/ пример чата "точка-точка". Если нужен какой-то протокол, то можешь посмотреть мой пример с "сетевыми шариками". Вообще, в последнее время мне больше понравилось прямое использование библиотеки WinSock - через API.

Оценка за ответ: 4.

3. [Отвечает: Матвеев И.В. (статус: Практикант), 12.02.2006 14:36]: Интересный вопрос!, какой клиент-сервер Вас интересует? TCP/IP, COM, а может InterBase. Если Вы имели ввиду TCP/IP соединение то вот:

// Сервер,- получение данных от клиента
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket:
  TCustomWinSocket);
var
  Str: string;
  RemIP: string;
begin
  RemIP := Socket.RemoteAddress;
  Str := Socket.ReceivedText;
end;

// Клиент,- передача сообщения серверу
var
  i: byte;
begin
  with ServerSocket1.Socket do
  begin
    if ActiveConnections>
    0 then
      for i := 0 to ActiveConnections - 1 do
      try
        Connections[i].SendText(Text);
        Application.ProcessMessages;
      except
        //
      end;
  end; {⁄WITH}
end;

В компонентах TServerSocket и TClientSocket соответственно в сервере и клиенте необходимо настроить порты - указать общий, пока не занатый другой программой порт, и нужно в клиенте в TClientSocket указать адрес сервера в свойстве Address.

Оценка за ответ: 5.

4. [Отвечает: midav.land.ru (статус: Студент), 13.02.2006 16:32]: Если у Вас Delphi6, то загляните в папочку Demos/Indy/TCPServer если 7, то в каталоге Demos/Indy лежит текстовый документ, в котором написано, откуда скачать примеры. Там много интересного.

Оценка за ответ: 5.

5. [Отвечает: Антон Трапезников (статус: Практикант), 15.02.2006 15:49]: Для этого Вам необходимо использовать сокеты, которые фактически представляют из себя логическую связку вида IP - Port и являются интерфейсом сетевого окончания. Как правило, сокеты базируются на протоколе TCP/IP, но иногда могут работать на других протоколах (например, IPX /etc). Важно помнить, что порты протокола TCP и UDP это не одно и то же! Хорошую статью по программированию серверных сокетов написал Nitro http://www.delphimaster.ru/articles/socksrv/index.html. На моей BDS 2006 компоненты TServerSocket/TClientSocket (описанные в статье) отсутствуют в палитре компонент (по моему, начиная с D6) и для того, чтобы их использовать придется подключит в uses модуль ScktComp, а затем создавать компоненты в коде: sockServer := TServerSocket.Create(frmMainWnd); После этого можете начинать работать. Еще могу рекомендовать компоненты со вкладки Indy, т.к. это очень богатая библиотека реализующая множесто сетевых сервисов.

Оценка за ответ: 5.

Вопрос #234:
Здравствуйте! Ниже приведу кусок кода. Проблема с функцией RegEnumValue, возвращает ошибку 259. Подскажите в чем тут проблема?

procedure TForm1.SkanKey(HKey_: HKEY; KeyStr, Name: string;
var Value: TRegKeyInfo;var Alist:TStringList);
var
key: HKEY;
i,j,d:integer;
CountKey,LenKey,NumVal: word;
KeyName,ValueName, st: string;
Mem: TMemoryStream;
RegType: byte;
SizeData: integer;
len: DWORD;
MaxData: integer;
// LenValue: DWORD;
begin
FillChar(value, SizeOf(TRegKeyInfo), 0);
ErrorCode:= RegOpenKeyEx(Hkey_,PChar(name) , 0, KEY_READ, Key);
if ErrorCode <> ERROR_SUCCESS then
Alist.Add('[RegOpenKeyEx ERROR № '+IntToStr(ErrorCode)+'] ' + name)
else try
ErrorCode:= RegQueryInfoKey(key,nil,nil,nil,@Value.NumSubKeys,
@Value.MaxSubKeyLen,nil,@Value.NumValues,@Value.MaxValueLen,
@Value.MaxDataLen,nil,nil);
if SysLocale.FarEast and (Win32Platform = VER_PLATFORM_WIN32_NT) then
with value do begin
inc(MaxSubKeyLen,MaxSubKeyLen);
inc(MaxValueLen,MaxValueLen);
end;
mem:= TMemoryStream.Create;
try
mem.SetSize(value.MaxDataLen);
Len:= value.MaxValueLen+1;
MaxData:= value.MaxDataLen;
if value.NumValues > 0 then
for j:= 1 to value.NumValues do begin
ErrorCode:= RegEnumValue(HKey_,j,PChar(ValueName),Len,0,@RegType,
mem.Memory, @MaxData);
if ErrorCode <> ERROR_SUCCESS then Break;
end;
finally
mem.Free;
end;
finally
RegCloseKey(key);
end;

1. [Отвечает: Гавриленко Евгений (статус: Эксперт: 2-ой класс), 12.02.2006 2:27]: Внимательно читать MSDN и Delphi Help: String и PChar - не одно и тоже. Запись в MemoryStream осуществляетя через методы write или writebuffer и т.д. Вообщем к делу:

var
...
ValueName:array of char;
buffer:array of byte;
begin
...
try
SetLength(ValueName,Value.MaxValueLen+1);
SetLength(buffer,value.MaxDataLen+1);
if value.NumValues > 0 then
for j:= 0 to value.NumValues-1 do begin
Len:=Value.MaxValueLen+1;
MaxData:=value.MaxDataLen+1;
ErrorCode:= RegEnumValue(key,j,@ValueName[0],Len,nil,nil, @buffer[0], @MaxData);
if ErrorCode <> ERROR_SUCCESS then
   Break;
mem.Write(buffer[0],MaxData);
end;
finally
...

Ниже выдержка из MSDN:

RegEnumValue
The RegEnumValue function enumerates the values for the specified open registry key. The function copies one indexed value name and data block for the key each time it is called.
LONG RegEnumValue(
HKEY hKey,
DWORD dwIndex,
LPTSTR lpValueName,
LPDWORD lpcValueName,
LPDWORD lpReserved,
LPDWORD lpType,
LPBYTE lpData,
LPDWORD lpcbData
);
Parameters

hKey
[in] Handle to an open key. The key must have been opened with the KEY_QUERY_VALUE access right. For more information, see Registry Key Security and Access Rights.
This handle is returned by the RegCreateKeyEx or RegOpenKeyEx function, or it can be one of the following predefined keys:
HKEY_CLASSES_ROOT
HKEY_CURRENT_CONFIG
HKEY_CURRENT_USER
HKEY_LOCAL_MACHINE
HKEY_PERFORMANCE_DATA
HKEY_USERS
Windows Me/98/95: This parameter can also be the following value:
HKEY_DYN_DATA

dwIndex
[in] Index of the value to be retrieved. This parameter should be zero for the first call to the RegEnumValue function and then be incremented for subsequent calls.
Because values are not ordered, any new value will have an arbitrary index. This means that the function may return values in any order.

lpValueName
[out] Pointer to a buffer that receives the name of the value, including the terminating null character.
For more information, see Registry Element Size Limits.

lpcValueName
[in, out] Pointer to a variable that specifies the size of the buffer pointed to by the lpValueName parameter, in TCHARs. This size should include the terminating null character. When the function returns, the variable pointed to by lpcValueName contains the number of characters stored in the buffer. The count returned does not include the terminating null character.
lpReserved
Reserved; must be NULL.

lpType
[out] Pointer to a variable that receives a code indicating the type of data stored in the specified value. For a list of the possible type codes, see Registry Value Types. The lpType parameter can be NULL if the type code is not required.

lpData
[out] Pointer to a buffer that receives the data for the value entry. This parameter can be NULL if the data is not required.
If lpData is NULL and lpcbData is non-NULL, the function stores the size of the data, in bytes, in the variable pointed to by lpcbData. This enables an application to determine the best way to allocate a buffer for the data.

lpcbData
[in, out] Pointer to a variable that specifies the size of the buffer pointed to by the lpData parameter, in bytes. When the function returns, the variable pointed to by the lpcbData parameter contains the number of bytes stored in the buffer. This parameter can be NULL only if lpData is NULL.
If the buffer specified by lpData is not large enough to hold the data, the function returns ERROR_MORE_DATA and stores the required buffer size in the variable pointed to by lpcbData. In this case, the contents of lpData are undefined.

Return Values
If the function succeeds, the return value is ERROR_SUCCESS.
If the function fails, the return value is a nonzero error code defined in Winerror.h. You can use the FormatMessage function with the FORMAT_MESSAGE_FROM_SYSTEM flag to get a generic description of the error.
Remarks
To enumerate values, an application should initially call the RegEnumValue function with the dwIndex parameter set to zero. The application should then increment dwIndex and call the RegEnumValue function until there are no more values (until the function returns ERROR_NO_MORE_ITEMS).
The application can also set dwIndex to the index of the last value on the first call to the function and decrement the index until the value with index 0 is enumerated. To retrieve the index of the last value, use the RegQueryInfoKey function.
While using RegEnumValue, an application should not call any registry functions that might change the key being queried.
To determine the maximum size of the name and data buffers, use the RegQueryInfoKey function.

Windows Me/98/95: RegEnumValueW is supported by the Microsoft Layer for Unicode. To use this, you must add certain files to your application, as outlined in Microsoft Layer for Unicode on Windows Me/98/95 Systems.

Оценка за ответ: 5.

2. [Отвечает: Матвеев И.В. (статус: Практикант), 12.02.2006 16:21]: Очень интерестную функцию Вы написали, пробовал в ней разобраться, но так и не получилось.. Например, зачем нужна Mem: TMemoryStream;, если она сразу после заполнения освобождается. Ну да ладно, это Ваше дело. В общем я написал функцию - аналог Вашей, она работает без ошибок (мне во-всяком случае не попадались), только я убрал из заголовка параметр KeyStr, так как он не используется. Вот:

procedure SkanKey(aKey: HKEY; KeyStr : string; var Value: TRegKeyInfo;
  aList: TStringList);
var
  tIndex   : Integer;
  tRes     : Integer;
  tString  : string;
  tTemp    : HKEY;
  tBuf     : Pointer;
  tBufSize : Cardinal;
begin
aList.Clear;
FillChar(Value, SizeOf(TRegKeyInfo), 0);
if not RegOpenKeyEx(aKey, PChar(KeyStr), 0, KEY_READ, tTemp) = ERROR_SUCCESS then Exit;
RegQueryInfoKey(tTemp, nil, nil, nil, @Value.NumSubKeys,
    @Value.MaxSubKeyLen, nil, @Value.NumValues, @Value.MaxValueLen,
    @Value.MaxDataLen, nil, nil);
if SysLocale.FarEast and (Win32Platform = VER_PLATFORM_WIN32_NT) then
  with Value do
   begin
    Inc(MaxSubKeyLen, MaxSubKeyLen);
    Inc(MaxValueLen, MaxValueLen);
   end;
tBufSize := Value.MaxValueLen;
GetMem(tBuf, tBufSize);
tIndex := 0;
tRes := ERROR_SUCCESS;
try
  SetLength(tString, tBufSize);
  while (tIndex < Value.NumValues) and (tRes = ERROR_SUCCESS) do
   begin
    tBufSize := Value.MaxValueLen;
    tRes := RegEnumValue(tTemp, tIndex, tBuf, tBufSize, nil, nil, nil, nil);
    if tRes = ERROR_SUCCESS then
     begin
      SetLength(tString, tBufSize);
      tString := Copy(PChar(tBuf), 0, tBufSize);
      aList.Add(tString);
     end;
    Inc(tIndex);
   end;
finally
  FreeMem(tBuf);
  RegCloseKey(tTemp);
end;
end;

Оценка за ответ: 5.

3. [Отвечает: midav.land.ru (статус: Студент), 13.02.2006 16:30]: Зачем так сложно писать? Не проще ли воспользоваться готовым класом TRegistry. В общем идея следующая: Не ко всем ключам можно обращаться. На некоторых стоит ключ только для чтения или, что ещё лучше, права доступа. И даже админ (Администратор) не может получить к ним доступ. Для этого вначале необходимо приписать права себе на этот ключ (ветку). Это очень похоже на папки. Попробуйте получить доступ к папке System Volume Information (под NTFS). неполучиться, пока не припишешь себе права на неё. ВОзможен также другой вариант, его любят вирусы. Имя ключа можно сделать с использованием непечатаемых символов, от которых стандарным функциям рвёт крышу. Для доступа к таким ключам используют нативные функции.

Оценка за ответ: 4.

Вопрос #235:
Помогите пожалуйста!!! Никак не могу написать программу, которая переносит данные из Excel в Word.

1. [Отвечает: Матвеев И.В. (статус: Практикант), 12.02.2006 16:42]: Нужно пытаться открыть Excel файл с помощью Word, если конвертор Microsoft Excel Worksheet установлен выпадет окошко, где нужно щелкнуть Ok и файл будет конфертирован в Word. Далее нужно просто Сохранить как... получившийся документ.

К сожалению сделать этот процесс полностью автоматизированным (чтобы не вылетало окошко конвертора) по-видимому невозможно.

Вот:

var
  WordApp  : Variant;
  SelfPath : string;
begin
SelfPath := ExtractFilePath(Application.ExeName);
WordApp := CreateOleObject('Word.Basic');
if not VarIsEmpty(WordApp) then
  begin
   if not WordApp.FileOpen(SelfPath+Edit1.Text) then Exit;
   WordApp.FileSaveAs(Name := SelfPath+Edit2.Text);
   WordApp.AppClose;
   WordApp := Unassigned;
  end
  else
   ShowMessage('Невозможно запустить MS Word');

Соответственно исходники утилитки прилагаю. Загрузить прикреплённый файл >>

Оценка за ответ: 5.

2. [Отвечает: Антон Трапезников (статус: Практикант), 15.02.2006 17:28]: Возможно вариант не оптимален, но Вы можете использовать для передачи буфер обмена. Навскидку:

Sheet := XLApp.Workbooks[1].WorkSheets[1];
Sheet.Range['a1c10'].Select;
XLApp.Selection.Copy;

//Копирование в буфер ячеек области A1 - C10

Затем

WordDocument.Content.Paste;

Вы можете почитать статьи (к сожалению, не помню автора) "По волнам интеграции", они есть в Королевстве Delphi.

А также советую посмотреть файлы Word\Excel.pas в \Borland\Delphi\Ocx\Servers.

И на последок поковырятся в MSDN:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/odc_2003_ta/html/odc_landoffice03_vba.asp

Оценка за ответ: 5.

Вопрос #236:
Как отследить момент двойного нажатия левой клавиши мыши в RichEdit? Надо, чтобы при этом действии выполнялись некоторые действия.

1. [Отвечает: SiNiK (статус: Эксперт: 3-ий класс), 11.02.2006 21:59]: Для решения этого вопроса, можно воспользоваться JvRichEdit'ом, который входит в состав JVCL (http://homepages.borland.com/jedi/).

Оценка за ответ: 4.

2. [Отвечает: Матвеев И.В. (статус: Практикант), 12.02.2006 16:57]: Дело в том, что сообщение WM_LBUTTONDBLCLK, которое возникает при двойном щелчке мышкой (левой кнопкой) обрабатывается еще в TControl - в секции protected, а TRichEdit наследуется в конечном счете от TControl, поэтому для того, чтобу получить событие OnDblClick в TRichEdit его необходимо просто определить в секции published. Для этого можно заново переписать компонент TRichEdit (исходники компонента прилагаю), или поправить модуль ComCtrls.

Загрузить прикреплённый файл >>

Оценка за ответ: 5.

3. [Отвечает: PVS (статус: Студент), 13.02.2006 9:59]: OnDblClick уже есть в RichEdit'e просто он спрятан. Можно его открыть:

TMyRichEdit = class(TRichEdit)
   published
    property OnDblClick;
end;

Но нужно иметь в виду, что все равно происходит выделение фрагмента текста, по которому Click'аем.

Оценка за ответ: 5.

4. [Отвечает: midav.land.ru (статус: Студент), 13.02.2006 16:40]: В компонента RichEdit нет обработчика двойного клика, странно, но кто нам мешает его туда добавить? Для этого пишем наследника TRichEdit и добавляем обработчик сообщения WM_LBUTTONDBLCLK.

Оценка за ответ: 3.

5. [Отвечает: Антон Трапезников (статус: Практикант), 15.02.2006 17:38]: Нужно поставить хук на сообщение WM_RBUTTONDBLCLK, которое генерируется когда пользователь делает двойной правый клик.

Выдержка из MSDN (прошу прощения, что на английском)

The WM_RBUTTONDBLCLK message is posted when the user double-clicks the
right mouse button while the cursor is in the client area of a window. If
the mouse is not captured, the message is posted to the window beneath the cursor.
Otherwise, the message is posted to the window that has captured the mouse.

A window receives this message through its WindowProc function.

Syntax

WM_RBUTTONDBLCLK

WPARAM wParam
LPARAM lParam;

Parameters

wParam
Indicates whether various virtual keys are down. This parameter can be one or more of the following values.
MK_CONTROL
The CTRL key is down.
MK_LBUTTON
The left mouse button is down.
MK_MBUTTON
The middle mouse button is down.
MK_RBUTTON
The right mouse button is down.
MK_SHIFT
The SHIFT key is down.
MK_XBUTTON1
Windows 2000/XP: The first X button is down.
MK_XBUTTON2
Windows 2000/XP: The second X button is down.
lParam
The low-order word specifies the x-coordinate of the cursor. The coordinate is relative to the upper-left corner of the client area.

The high-order word specifies the y-coordinate of the cursor. The coordinate is relative to the upper-left corner of the client area.
Return Value

If an application processes this message, it should return zero.

А вот рабочий пример установки глобального хука на мышь (взято из DRKB)

========== Все, что ниже взято из DRKB (Автор Song) ==================
Возможные вариации: Любые вопросы, связанные с постановкой хука. Например "Как отследить [что-то]", "Как подменить [какое-то действие]", "Как заблокировать комбинации клавиш, как заблокировать определённые действия", "Как не дать запускаться определённым приложениям, не дать открываться определённым окнам?", "Как получить список запущенных оконных приложений?" и т.д.

Рабочий пример глобальной блокировки правой кнопки мыши:
DLL:

library Project2;
Uses Windows,Messages;
Var SysHook:HHook=0;

Function SysMsgProc(Code:Integer; WParam:LongInt; LParam:LongInt):LongInt; stdcall;
Var Msg:TMessage;
Begin
IF Code=HC_ACTION then
Case TMsg(Pointer(LParam)^).Message OF
WM_RBUTTONDOWN,WM_RBUTTONUP,WM_RBUTTONDBLCLK: TMsg(Pointer(LParam)^).Message:=WM_NULL
else Result:=CallNextHookEx(SysHook,Code,WParam,LParam);
End;
end;

procedure Hook(Flag:Boolean); export; stdcall;
Begin
IF Flag then SysHook:=SetWindowsHookEx(WH_GETMESSAGE,@SysMsgProc,HInstance,0) Else
Begin
UnhookWindowsHookEx(SysHook);
SysHook:=0;
End;
End;

exports Hook;

{$R *.res}

begin
end.

----------------------------
Project:

unit Unit1;

interface

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

type
MyProcType = procedure (Flag: Boolean); stdcall;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
HDLL:HWND;

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IF Button=mbRight then ShowMessage('Right mouse key pressed');
end;

procedure TForm1.Button1Click(Sender: TObject);
Var Hook: MyProcType;
Begin
@Hook:=nil;
HDLL:=LoadLibrary(PChar('project2.dll'));
IF HDLL>HINSTANCE_ERROR then
Begin
@Hook:=GetProcAddress(HDLL,'Hook');
Hook(True);
End else MessageDlg('Ошибка загрузки DLL.',mtError,[mbIgnore],0);
end;

procedure TForm1.Button2Click(Sender: TObject);
Var Hook: MyProcType;
Begin
@Hook:=nil;
IF HDLL>HINSTANCE_ERROR then
Begin
@Hook:=GetProcAddress(HDLL,'Hook');
Hook(False);
End;
End;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Button2.Click;
end;

end.

Файлы для демонстрации можно взять здесь: http://coolsong.narod.ru/hook.rar.
Работает так: при неустановленном хуке правая кнопка работает (о чём свидетельствует нажатие правой кнопки мыши - событие TForm.onMouseDown и сообщение). После установки хука кнопкой "Install", события от мыши перестают обрабатываться (сообщение "Right mouse key pressed" не выдаётся). после снятия хука (кнопка "Remove") - всё возвращается к первоначальному состоянию.

Если требуется перехватывать клавиши, тогда из вышеобозначенной теории нам известны варианты: WH_KEYBOARD, WH_KEYBOARD_LL или WH_GETMESSAGE+WM_CHAR/WM_KEYDOWN/UP
Однако, если требуется перехватить всего лишь отдельную клавишу, будь то одну либо с нажатым Ctrl, Alt, Shift, рациональней для этого воспользоваться назначением горячей клавиши, через RegisterHotKey().
Рабочий пример такого приёма:

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
protected
procedure hotykey(var msg: TMessage); message WM_HOTKEY;
end;

var
Form1: TForm1;
id, id2: Integer;

implementation

{$R *.DFM}

procedure TForm1.hotykey(var msg: TMessage);
begin
if (msg.LParamLo = MOD_CONTROL) and (msg.LParamHi = 81) then
begin
ShowMessage('Ctrl + Q wurde gedrьckt !');
end;

if (msg.LParamLo = MOD_CONTROL) and (msg.LParamHi = 82) then
begin
ShowMessage('Ctrl + R wurde gedrьckt !');
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
id := GlobalAddAtom('hotkey');
RegisterHotKey(handle, id, mod_control, 81);

id2 := GlobalAddAtom('hotkey2');
RegisterHotKey(handle, id2, mod_control, 82);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey(handle, id);
UnRegisterHotKey(handle, id2);
end;

Блокировка клавиатуры/мыши.

Родственная тема, поэтому помещена в этот же вопрос.

Итак, заблокировать можно хуком. Но в некоторых случаях можно обойтись и "малой кровью".
Вы можете использовать ф-ию BlockInput. Она живёт в user32.dll Также она блокирует одновременно и мышь.

Procedure BlockInput(ABlockInput : Boolean); stdcall; external 'USER32.DLL';

BlockInput(True); - заблокировать

BlockInput(False); - разблокировать

Однако имейте ввиду, что BlockInput() не заблокирует CAD. Кроме того, её работа блокируется по нажатию трёх пальцев.Для блокировки CAD в w9x, мы можем использовать режим скринсэйвера, в NT, увы никак.
Ф-ия BlockInput() явилась продолжением ф-ии EnableHardwareInput(), которая как мы знаем использовалась в 16-разрядных приложениях.
Кроме того, для блокировки, мы можем использовать некоторые недокументированные возможности, однако их недастаток в том, что обратно клавиатуру/мышь уже включить нельзя:

"rundll32 keyboard,disable" - заблокироовать клавиатуру
"rundll32 mouse,disable" - заблокировать мышь

Запустить эти команды мы можем самое простое через ShellExecute() или WinExec():
ShellExecute(Application.Handle,'open','C:\Windows\Rundll32.exe',
'команда','C:\Windows',SW_HIDE);

=======================================================

Оценка за ответ: 5.

6. [Отвечает: Константин Завальный (KOZ) (статус: Эксперт: 1-ый класс), 21.02.2006 0:47]: Вообще-то у компонента RichEdit нет события OnDblClick. Но можно сделать примерно так. В событии OnMouseUp пропишите:

if clck=true then
begin
//Do something...
end else clck:=true;

Кинуть на форму таймер, в OnTimer пропишите clck:=false; И не забудьте в разделе var объявить переменную clck типа boolean. Работает это так: Изначально clck равна false. Если вы нажали один раз на компонент, то clck примет true. Когда Вы второй раз щелкните по компоненту, то выполнится ваш код. А чтобы задать максимально допустимый интервал между кликами, используется таймер, обнуляющий clck. Удачи!

Оценка за ответ: 4.

10. [Отвечает: sattar (статус: Эксперт: 3-ий класс), 21.02.2006 19:08]: File\Close All
File\New\Unit
Приведи код к следующему виду:
unit RichEdit1;
interface
uses
SysUtils, Classes, Controls, StdCtrls, ComCtrls;
type
TRichEdit1 = class(TRichEdit)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
property OnDblClick;
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TRichEdit1]);
end;
end.
Сохрани юнит с названием TRichEdit1. Потом Component\InstallComponent. В поле UnitFileName впиши путь и название файла, который ты создал. Потом ОК,Yes,ОК. На закладке Samples найдешь компонент TRichEdit1, он будет иметь сообщение OnDblClick.

Оценка за ответ: 5.

Вопрос #237:
Ребят, плиз помогите !!! 1) Как сделать, чтоы брался текст из Edit, анализировался, в папке с прогой искался файл с названием=тексту из Edit и этот файл отображался в Memo? 2) То же с картинками. Плиз!

1. [Отвечает: Деревянко Евгений (статус: Эксперт: 5-ый класс), 12.02.2006 3:38]: Все помещется в одной строчке кода =))

Memo.Lines.LoadFromFile(ExtractFilePath(paramstr(0)) + Edit.text);

Оценка за ответ: 4.

2. [Отвечает: Aleksey Mayboroda (статус: Эксперт: 2-ой класс), 12.02.2006 8:30]:

if FileExists(Edit1.Text) then
  Memo1.Lines.LoadFromFile(Edit1.Text)
else
  Memo1.Lines.Add('Файла ' + Edit1.Text + ' не существует');

С картинкой точно также только вместо Memo1.Lines.LoadFromFile(Edit1.Text) пишем это: Image1.Picture.LoadFromFile(Edit1.Text);

Оценка за ответ: 5.

3. [Отвечает: Матвеев И.В. (статус: Практикант), 12.02.2006 17:06]: 1. Для текста:

var
  SelfPath : string;
begin
SelfPath := ExtractFilePath(Application.ExeName);
if FileExists(SelfPath+Edit1.Text) then
   Memo1.Lines.LoadFromFile(SelfPath+Edit1.Text) else
     Memo1.Lines.Text := 'Файл "'+Edit1.Text+'" не найден в директории программы';

2. Для картинок:

var
  SelfPath : string;
begin
SelfPath := ExtractFilePath(Application.ExeName);
if FileExists(SelfPath+Edit1.Text) then
  try
   Image1.Picture.LoadFromFile(SelfPath+Edit1.Text);
  except ShowMessage('Ошибка при загрузке изображения, возможно файл не того формата');
  end else
     ShowMessage('Файл "'+Edit1.Text+'" не найден в директории программы');

И добавьте модуль Jpeg в список модулей, чтобы JPEG изображения тоже загружались.

Оценка за ответ: 5.

4. [Отвечает: Антон Трапезников (статус: Практикант), 13.02.2006 12:40]:

var
  FileName: String;
...

begin
  FileName := Edit1.Text;

  // Если в текущей папке существует файл с именем введенным в Edit1
  // и расширением RTF, то
  if FileExists(GetCurrentDir + '\'+FileName+'.rtf') = true  then
    begin
      Memo1.Lines.LoadFromFile(GetCurrentDir + '\'+FileName+'.rtf');
      // Загрузить в Memo1 этот файл
    end
      else
    ShowMessage('Файл не найден!');

Кстати, FileExists(GetCurrentDir + '\'+FileName+'.rtf') можно заменить на FileExists(FileName+'.rtf'), при этом поиск все-равно будет осуществлятся в текущей папке. Я использовал функцию GetCurrentDir лишь для того, чтобы показать каким образом можно узнать путь текущей папки.

С картинками будет также, только Memo нужно будет заменить на Image.

Оценка за ответ: 5.

5. [Отвечает: PVS (статус: Студент), 13.02.2006 10:03]: Текст:
Memo1.Lines.LoadFromFile(ExtractFileDir(Paramstr(0))+'\'+Edit1.Text);
Картинка:
Image1.Picture.LoadFromFile(ExtractFileDir(Paramstr(0))+'\'+Edit1.Text);

Оценка за ответ: 5.

6. [Отвечает: Середюк И. А. (статус: Эксперт: 1-ый класс), 13.02.2006 15:02]:

unit Poist_file;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
if FileExists(ExtractFilePath(ParamStr(0))+Edit1.Text)
then
  begin
  Memo1.Lines.Clear;
  Memo1.Update;
  Memo1.Lines.Add(ExtractFilePath(ParamStr(0))+Edit1.Text);
  Memo1.Update;
  end
else
  if (Application.MessageBox(PChar('Файл '+Edit1.Text+'  не найден !!!'),
      'Результат поиска!', MB_OK+MB_ICONWARNING)<>IDYES)
  then
   begin
   Memo1.Lines.Clear;
   Memo1.Update;
   Edit1.SetFocus;
   Edit1.SelStart:=Length(Edit1.Text);
   end;

end;

end.

Оценка за ответ: 5.

7. [Отвечает: midav.land.ru (статус: Студент), 13.02.2006 16:07]: Не понял, что понимается под словом "анализируется". Для кнопки, которая должна обрабатывать действие по загрузке должна выглядеть так:

Memo1.lines.LoadFromFile(ExtractFilePath(Application.exename)+Edit1.text);

"Фразу" ExtractFilePath(Application.exename)+ можно опустить, но в некоторых случаях, когда текущим каталогом будет не каталог с exe-шником, не будет работать Для картинок не сложней Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+Edit1.text);

Оценка за ответ: 5.

8. [Отвечает: tmp (статус: Эксперт: 1-ый класс), 14.02.2006 0:26]: memo1.lines.loadfromfile(edi1.text) - загружает в мемо файл с именем, что находится в edit1.

Оценка за ответ: 3.

9. [Отвечает: Константин Завальный (KOZ) (статус: Эксперт: 1-ый класс), 21.02.2006 1:04]:

procedure TForm1.Button1Click(Sender: TObject); //При щелчке на кнопке
var
path: string; //для удобства вводим переменную
begin
path:=ExtractFilePath(Application.ExeName)+Edit1.Text; //Путь к файлу
Memo1.Lines.LoadFromFile(path); //Загружаем его в Мемо
end;

Некоторые комментарии:
ExtractFilePath - выделяет путь поиска из полного имени файла
Application.ExeName - возвращает полный путь к программе
Если заранее изветно расширение файла и его не нужно прописывать в Edit, то
измените строку на path:=ExtractFilePath(Application.ExeName)+Edit1.Text+'.txt';
P.S. Картинки: Image1.Picture.LoadFromFile(str);
Удачи!

Оценка за ответ: 5.

10. [Отвечает: sattar (статус: Эксперт: 3-ий класс), 21.02.2006 18:39]: 1.Memo1.Lines.LoadFromFile(getcurrentdir+'\'+Edit1.Text+'.txt');
2.Image1.Picture.LoadFromFile(getcurrentdir+'\'+Edit1.Text+'.jpg');

Оценка за ответ: 5.

Вопрос #238:
Как можно связать TADOQuery и TQueryTableProducer?

1. [Отвечает: Alexey (статус: Эксперт: 2-ой класс), 13.02.2006 15:57]:Не знаю на сколько Вам поможет то, что скажу, но все же - у TQueryTableProducer есть метод SetQuery и SetDataSet - тык вот в TDSTableProducer, от которого порожден этот самый TQueryProducer есть вот что - procedure SetDataSet(ADataSet: TDataSet); virtual; abstract; , что наводит на мысль - пишем класс обертку для TDSTableProducer на подобие TQueryTableProducer, Только вместе строк типа AQuery:=(DataSet as TQuery); Пишем AQuery:=(DataSet as TADOQuery); или делаем метод SetQuery перегруженным. Вот такие мысли после беглого просмотра исходников, за работоспособность сего не берусьучаться, но это выглядит вполне осуществимым и даже не очень сложным.

Оценка за ответ: 5.

2. [Отвечает: Антон Трапезников (статус: Практикант), 17.02.2006 10:20]: Попробуйте добавить следующий код в обработчик создания модуля

QueryTableProducer1.Query := TQuery(ADOQuery1);

Оценка за ответ: 4.

Вопрос #239:
1. Как определить размер MP3 файла который находится на CD диске? Использовал функцию filesize(var f), но она не работает. 2. Как определить качество звука MP3 файла? 3. И еще очень волнующий меня вопрос: Как выяснить позицию по X движка в trackbare? Заранее спасибо!

1. [Отвечает: SiNiK (статус: Эксперт: 3-ий класс), 11.02.2006 21:59]: Размер файла можно определить так:

function GetFileSize(FileName: String): Integer;
var
  FS: TFileStream;
begin
  try
    FS := TFileStream.Create(Filename, fmOpenRead);
  except
    Result := -1;
  end;
  if Result <> -1 then Result := FS.Size;
  FS.Free;
end;

Bitrate можно попробовать определить с помощью компонента TAudioInfo (www.yandex.ru :-))

Определение позиции TrackBar можно с помощью TrackBar1.Position.

Оценка за ответ: 4.

2. [Отвечает: Матвеев И.В. (статус: Практикант), 12.02.2006 17:50]: 1. Определение размера.

Дело в том, что у Вы не можете записать на CD диск, а функция Reset пытается открыть файл в режиме полного доступа и поэтому вызов проваливается. Вы можете установить режим "только для чтения" и все получится. Вот:

var
  F : file of Byte;
begin
AssignFile(F, Edit1.Text);
FileMode := 0;
Reset(F);
ShowMessage(IntToStr(FileSize(F)));
CloseFile(F);

Учтите только, что функция FileSize возвращает число записей в файле, а не размер в байтах, поэтому А нужно объявлять как file of Byte.

Можно получить размер и через потоки, вот так:

var
FS : TFileStream;
begin
FS := TFileStream.Create(Edit1.Text, fmOpenRead);
ShowMessage(IntToStr(FS.Size));
FS.Free;

А можно и с помощью API:

var
tFile : hFile;
begin
tFile := CreateFile(PChar(Edit1.Text),
           GENERIC_READ, FILE_SHARE_READ,
           nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
ShowMessage(IntToStr(GetFileSize(tFile, nil)));
CloseHandle(tFile);

2. Качество звука.

Могу предложить только первое, что пришло в голову - взять размер файла и поделить его на длительность файла в секундах. Это конечно не лучший вариант, результат будет неточным, т.к. пренебрегается размер заголовка и ID3 тег.

Вот как это могло бы выглядеть:

var
FS : TFileStream;
SS : Integer;
begin
FS := TFileStream.Create(Edit1.Text, fmOpenRead);
SS := FS.Size;
FS.Free;

MediaPlayer1.FileName := Edit1.Text;
MediaPlayer1.Open;
ShowMessage('Качество: ' + IntToStr(SS div (MediaPlayer1.Length div 1000)));

3. Как выяснить позицию по X движка в trackbare?

Просто установить TrackBar.Max := MP3.Length и тогда позиция TrackBar-а будет позицией проигрывания.

Оценка за ответ: 5.

3. [Отвечает: midav.land.ru (статус: Студент), 13.02.2006 16:16]: Мож Вы имели ввиду не MP3 а Audio - CD. Иначе говорить про то, что он на компакте нет смысла. Но если всё заключается в MP3, то необходимо прочитать теги, а оттудова извлекается много интересной инфы. Вобщем читайте по нижеприведённым ссылкам, там примеры и много интересного (и всё на русском):
Http://www.delphiworld.narod.ru/base/wav_file_length.html
Http://www.delphiworld.narod.ru/base/get_id3tag_v1.html
Http://www.delphiworld.narod.ru/base/get_mp3.html
Http://www.delphiworld.narod.ru/base/mp3_work.html
Http://www.delphiworld.narod.ru/base/id3_mp3.html
Http://www.delphiworld.narod.ru/base/cd_player.html - это пример простенького CD плеера.
Http://www.delphiworld.narod.ru/base/get_wav_duration.html

Оценка за ответ: 5.

4. [Отвечает: senser@elsite.ru (статус: Эксперт: 2-ой класс), 17.02.2006 21:29]: размер файла который находится на CD диске?

function X_FileSize(FileName:string):int64;
var h:THandle;
begin
  h:=FileOpen(FileName, fmOpenRead or fmShareDenyNone);
  if h>0 then begin
   Result:=GetFileSize(h,nil);
   FileClose(h);
  end else Result:=0;
end;

Оценка за ответ: 5.

Вопрос #241:
D6.TWebBrowser. IE6.0. Win2k, WinXP.Необходимо организовать некое подобие оффлайн-браузера. На форме имеются TShellTreeView и TWebBrowser. Проблема в том, что после нескольких кликов по ShellTreeView (10-20 раз) происходит аварийное завершение программы с любимым сообщением:
Project Project1.exe raised exception class EAccessViolation with message 'Access violation at address 0040358C in module 'Project1.exe'. Read of address 0000002C'. Process stopped. Use Step or Run to continue.
Аналогичное сообщение возникает при выходе из программы при запуске уже откомпилированного exe-шника из Windows. Делаю так:

procedure TMainForm.TreeViewChange(Sender: TObject; Node: TTreeNode);
var
F, FName: OleVariant;
Ext: String; begin
F:= 0;
FName:= TreeView.Path;
Ext:= LowerCase(ExtractFileExt(TreeView.Path));
if (Ext = '.htm') or (Ext = '.html') or
(Ext = '.php') or (Ext = '.shtml') then
WebBrowser.Navigate2(FName,F,F,F,F); // Navigate ?
end;

От "железа " не зависит - пробовал на других машинах - результат тот же. В Help'е ничего про WebBrowser нет. Подскажите, как правильно рганизовать загрузку HTML-страничек с локального диска.

1. [Отвечает: SiNiK (статус: Эксперт: 3-ий класс), 11.02.2006 21:59]: Delphi 2005, XP+SP2, IE6. Кликал до отупения :-) , но ничего не произошло.

Оценка за ответ: 2.

2. [Отвечает: Матвеев И.В. (статус: Практикант), 12.02.2006 18:00]: Не уверен, что ошибка в этом, но вообще за типом OleVariant водятся такие вот непонятные ошибки. Попробуйте так:

var
Ext, FName: string;
Fo : OleVariant;
begin
FName:= ShellTreeView1.Path;
Ext:= LowerCase(ExtractFileExt(ShellTreeView1.Path));
if (Ext = '.htm') or (Ext = '.html') or
(Ext = '.php') or (Ext = '.shtml') then
   begin
    fo := FName;
    WebBrowser1.Navigate2(Fo); // Navigate ?
   end;

Оценка за ответ: 4.

3. [Отвечает: midav.land.ru (статус: Студент), 13.02.2006 16:22]: Это проблема компонента ShellTreeView. Сыроват он немного. Варианты выхода. Попробовать перейти на 7 Делфи, так как в общем она более устойчива. Переписать компонент ShellTreeView под себя, благо примеров сети много. Простенький вариант здесь: http://www.delphiworld.narod.ru/base/listview_files_list.html или здесь http://www.delphiworld.narod.ru/base/files_list_with_icons.html.

Оценка за ответ: 5.

4. [Отвечает: sattar (статус: Эксперт: 3-ий класс), 21.02.2006 18:08]: Попробуй вместо Navigate2 -> Navigate.

Оценка за ответ: 3.

Все вопросы и ответы на них Вы всегда можете найти на нашем сайте в разделе "Delphi-Эксперт".


Статья по Delphi.

Написание простого медиа-проигрывателя (часть 2)

Автор: Ерёмин Андрей

Продолжим нашу работу над медиа-проигрывателем, основанным на Windows Media Player. Хочется подчеркнуть, что кардинально изменить что-либо не удастся, поэтому в этой статье я просто расскажу о небольших усовершенствованиях и на этом мы остановимся.

Обычно во время воспроизведения мы должны видеть название файла, который проигрывается в данное время. Давайте снабдим проигрыватель этой функцией. Для этого изменим обработчик пункта меню "Открыть" на следующее:

if OpenDialog.Execute then
begin
      MediaPlayer.URL:=OpenDialog.FileName;
      Form1.Caption:='SMP - '+ExtractFileName(OpenDialog.FileName);
end;

Как работает добавленная строка? Функция ExtractFileName() возвращает имя файла из указанного пути - то, что нам нужно. "SMP" - это сокращённо "Simple Media Player" :-) Наконец, значение присваивается заголовку формы.

Что ещё можно добавить? Да, действительно странный проигрыватель... Можно сделать окошко "О программе". Для этого в меню добавьте соответствующий пункт и назовите его "О программе..." По правилам Windows любая надпись, приводящая к открытию диалогового окна, должна заканчиваться многоточием - "..." Рекомендую запомнить это правило и всегда и везде его использовать. Окно можно создать "с нуля": File - New - Form (в разных версиях Delphi названия пунктов меню могут отличаться). А ещё можно воспользоваться окном, подготовленным разработчиками - открываем File - New - Other, переходим на вкладку Forms, выбираем "About box" и нажимаем "ОК". В результате создаётся форма. В ней напишите название программы, своё имя, версию... Далее создаём обработчик для созданного пункта меню

AboutBox.ShowModal;

Пытаемся запустить программу, но Delphi выдаёт предупреждение, что второй модуль не связан с первым и предлагает это сделать. Соглашаемся, и приложение запускается.

Вот и всё. Конечно, такому проигрывателю далеко до Winamp, Light Alloy и даже до стандартного Windows Media Player, но основы, я думаю, понятны. Если вы повнимательнее изучите список ActiveX-компонент, то найдёте там много интересного.

Присылайте свои статьи по адресу info@delphi.int.ru с темой 'Articles' (без кавычек), и они будут опубликованы в ближайших выпусках рассылки и на сайте. Также вы можете заполнить вот эту форму. Большая просьба: статью оформляйте в -txt или -doc формате и используйте -zip или -rar сжатие (без самораспаковки).


Файловый архив.

Из данного раздела Вы можете скачать различные файлы: компоненты, plug-in'ы для Delphi, документацию по программированию, программы, игры, написанные на Delphi и всё остальное... Вы можете добавить свои файлы в данный раздел. Чтобы сделать это, пожалуйста, заполните форму на сайте.

К сожалению, новых файлов на сайте нет.

Название / описание файла
Категория
Объём
Ссылки

Чтобы перейти к разделу "Файловый архив" на сайте, нажмите на эту ссылку.

Дружественные сайты.

Здесь представлены ссылки на дружественные сайты. Обмен ссылками и баннерами всегда приветствуется. Здесь представлены самые последние ссылки:

На сайте собрана большая коллекция компонентов, исходников, статей, книг, что пригодится начинающему программисту. Всё это и многое другое вы найдёте на этом сайте.
http://romodos.pp.ru/
Romodos Software - Лучшие бесплатные программы, игры, музыка, рассылки, анекдоты, статьи, учебники по Delphi, HTML, JavaScript, Windows.
http://www.sassoft.narod.ru/
На данном сайте вы сможете найти разные полезные программы. Также имеется подписка на рассылку и разная полезная информация программисту.
http://www.excode.ru/
Статьи, исходники, компоненты, книги, кодерский магазин.
Рассылки Subscribe.Ru
Интернет для Delphi-программиста
Visual Basic для новичков и профессионалов
ExCode.ru - программирование на высоком уровне
   
 

Юмор.

:))

Присылайте свои анекдоты по этой ссылке: info@delphi.int.ru и они обязательно будут опубликованы. Желательно на компьютерную тему.

Товарищи программисты! Проявляйте свою активность. Давайте помогать друг другу! Если вы не нашли ответа на свой вопрос, не отчаивайтесь! Количество подписчиков постоянно растёт и, наверняка, найдётся тот человек, который поможет вам! а сегодня всё. До встречи через неделю!
Ведущий рассылки, Ерёмин Андрей.

Наши реквизиты в системе WebMoney: R379291065219, Z165075684614.


В избранное