Жемчужина Сибири

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

SeM — Mon, 02 May 2011 10:29:49 GMT

//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:='xxxx'; // логин отправителя
msg.Recipients.EMailAddresses:='xxxx@mail.ru'; // кому отправить письмо
msg.IsEncoded:=true;
attach:=TIdAttachment.Create(msg.MessageParts,'c:/Tmomos.txt'); // вложение {indy 9.00.10}
// attach:=TIdAttachmentFile.Create(msg.MessageParts,'c:/Tmomos.txt');// вложение {indy 10.5.5; 10.5.7}

idSMTP1.Connect();
if idSMTP1.Connected then
begin

idSMTP1.Send(msg);

IdSMTP1.Free;
attach.Free;
msg.Free;

end

else

begin

IdSMTP1.Disconnect;

IdSMTP1.Free;
attach.Free;
msg.Free;

end;

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

SeM — Sat, 23 Apr 2011 21:47:18 GMT

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

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

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

SeM — Thu, 21 Apr 2011 06:38:01 GMT

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

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

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

SeM — Wed, 13 Apr 2011 18:47:21 GMT

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

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

SeM — Sat, 09 Apr 2011 21:46:48 GMT

uses ShellAPI;

...

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

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

SeM — Sat, 09 Apr 2011 09:12:17 GMT

Пример, который я сейчас хочу вам показать, применим только для программ работающих в фоновом режиме (для других в этом просто нет смысла). Т.е программ, которые постоянно сидят в памяти и не мозоля глаза пользователю занимаются своими делами. Данный 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;

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

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

SeM — Wed, 06 Apr 2011 15:50:52 GMT

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
Result := False;
Break;
End;
Delete( path, oldlen+1, 255 );
End;
retval := FindNext( SRec );
End;
FindClose( SRec );
End; // Recurse
//__________________________________________________________________________
Begin
If path = '' Then GetDir(0, fullpath)
Else fullpath := path;

If fullpath[Length(fullpath)] <> '\' Then fullpath := fullpath + '\';

If mask = '' Then Recurse(fullpath, '*.*')
Else Recurse(fullpath, mask);
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
FindRecursive('c:\program files\Borland\','*.*');
end;

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

SeM — Wed, 30 Mar 2011 05:27:04 GMT

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);

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

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

SeM — Fri, 25 Mar 2011 08:17:33 GMT

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

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

SeM — Thu, 24 Mar 2011 08:38:27 GMT

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;