Блог - Жемчужина Сибири

Отправка с вложением на delphi 2010

//uses ...IdAttachmentFile; {indy 10.5.5; 10.5.7}
....
var
attach: TidAttachment; {indy 9.00.10}
// attach: TIdAttachmentFile; {indy 10.5.5; 10.5.7}
msg: tidmessage;

begin
// idSMTP1.AuthType:=satDefault; {indy 10.5.5; 10.5.7} // тпип авторизации

idSMTP1.AuthenticationType:=atLogin; {indy 9.00.10} // тпип авторизации
idSMTP1.Username:='xxxx'; // логин отправителя
idSMTP1.Password:='****'; // пароль отправителя
idSMTP1.Host:='smtp.mail.ru'; // хост mail.ru

IdSMTP1.Port:=25; // порт mail.ru

msg:=TIdMessage.Create(nil);

msg .CharSet := 'UTF-8';
msg .ContentTransferEncoding := '8bit';
msg.ContentType:='text/plain'; // эту строчку добовлять в зависимости от того как будет работать сама программа

msg.Body.Text := Memo1.Text;

msg.Body.Add('Test'); // текст письма
msg.Subject:='Test mail'; // Тема
msg.From.Address:='xxxx@mail.ru'; // от кого отправляем письмо
msg.From.Name:= ... Читать дальше »

Категория: Delphi | Просмотров: 1025 | Добавил: SeM | Дата: 02.05.2011 | Комментарии (0)

Прилипание окна к краям экрана

А как же изменить расстояние на которое нужно подвести форму, чтобы она прилипла? Есть свойство SnapBuffer. По умолчанию оно равно 10.

Пример использования:
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.ScreenSnap:=true;
Form1.SnapBuffer:=15;
end;

Категория: Delphi | Просмотров: 551 | Добавил: SeM | Дата: 24.04.2011 | Комментарии (0)

Бан в делфи 2010 и БАСС

вот правильно подгружать файл в делфи 2010

BASS_StreamCreateFile(FALSE, PChar(opendialog1.filename), 0, 0, BASS_UNICODE);

Категория: Delphi | Просмотров: 563 | Добавил: SeM | Дата: 21.04.2011 | Комментарии (0)

сворачивалась в трей компонент TTray

procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
...
procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
if Msg.CmdType = SC_MINIMIZE then
hide;
else
inherited;

end;

или

procedure TForm4.WMSysCommand(var Msg: TWMSysCommand);
begin
if Msg.wParam = SC_MINIMIZE then
begin
hide;
end;
inherited;
end;

SC_CLOSE,SC_MINIMIZE

Категория: Delphi | Просмотров: 463 | Добавил: SeM | Дата: 14.04.2011 | Комментарии (0)

Форматирование

uses ShellAPI;

...

ShellExecute (Handle, nil, 'format c: /fs:[тут файловая система ntfs или, fat32(без скобок)]', nil, nil, SW_RESTORE);

Категория: Delphi | Просмотров: 452 | Добавил: SeM | Дата: 10.04.2011 | Комментарии (0)

Учимся освобождать занимаемую программой память на Delphi

Пример, который я сейчас хочу вам показать, применим только для программ работающих в фоновом режиме (для других в этом просто нет смысла). Т.е программ, которые постоянно сидят в памяти и не мозоля глаза пользователю занимаются своими делами. Данный delphi исходник подойдет при создания троянов, вирусов, планировщика задач и.т.д. Для таких приложений крайне важным является объем потребляемой памяти, и разработчик должен свести его к минимуму.
Переходим к коду:

Создаем простенькую процедуру после вызова которой наша Delphi программа освободит всю ненужную ей память.

uses Windows, SysUtils;

procedure TrimWorkingSet;
var
MainHandle: THandle;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID);
SetProcessWorkingSetSize(MainHandle, DWORD(-1), DWORD(-1));
CloseHandle(MainHandle);
end;
end;

Пользуйтесь на здоровье !

Категория: Delphi | Просмотров: 590 | Добавил: SeM | Дата: 09.04.2011 | Комментарии (0)

Поиск файлов по маске на компе

Procedure FindRecursive(Const path: String; Const mask: String);
Var
fullpath: String;

Function Recurse( Var path: String; Const mask: String ): Boolean;
Var
SRec: TSearchRec;
retval: Integer;
oldlen: Integer;
Begin
Recurse := True;
oldlen := Length(path);
retval := FindFirst(path+mask, faAnyFile, SRec);
While retval = 0 Do Begin
Application.ProcessMessages;
If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then
Form1.ListBox1.items.Add(path+srec.name);
Form1.Caption:='Found '+IntToStr(Form1.ListBox1.items.Count)+' files...';

retval := FindNext(SRec);
End;
FindClose(SRec);

If not Result Then Exit;

retval := FindFirst( path+'*.*', faDirectory, SRec);
While retval = 0 Do Begin
If (SRec.Attr and faDirectory) <> 0 Then
If (SRec.Name <> '.') and (SRec.Name <> '..') Then Begin
path := path + SRec.Name + '\';
If not Recurse( path, mask ) Then Begin
... Читать дальше »

Категория: Delphi | Просмотров: 798 | Добавил: SeM | Дата: 06.04.2011 | Комментарии (0)

Замена иконки

uses

..., acWorkRes;

var q:dword;
begin
...
q:=BeginUpdateResourceS('C:\exefile.exe', False); //пусть к программе у которой менять иконку
if q <> 0 then begin
if not(ReplaceIconGroupResourceS(q, 'MAINICON', 0, 'C:\iconfile.ico')) then begin // Путь к иконке
EndUpdateResource(q, False);
exit;
end;
MessageBox(0,'Иконка изменена','',MB_ICONINFORMATION);
EndUpdateResource(q, False);

модуль закинуть в папку с прогой Скачать

Категория: Delphi | Просмотров: 547 | Добавил: SeM | Дата: 30.03.2011 | Комментарии (0)

Запуск батника

ShellExecute(Application.Handle,'open',PChar(Memo.Lines.GetText),'',PChar('<каталог>'),0);

Категория: Delphi | Просмотров: 524 | Добавил: SeM | Дата: 25.03.2011 | Комментарии (0)

Сохранение данных из библиотеки

var
hLib: Handle;
rsDrivers: TResourceStream;
begin
hLib:= LoadLibrary('MyDll.dll');
rsDrivers:= TResourceStream.Create(hLib, 'testResource', RT_RCData);
rsDrivers.SaveToFile('C:\Test.txt');
rsDrivers.Free;
FreeLibrary(hLib);
end;

Категория: Delphi | Просмотров: 540 | Добавил: SeM | Дата: 24.03.2011 | Комментарии (0)

1 2 3 4 5 »