Ivan Revelli - Synaptica srl

Delphi XE2 – Native compression support “ZIP” & “UNZIP”

per Ivan Revelli
in Senza categoria
on Febbraio 12, 2012

0

In questi giorni comincio a metter mano su questo nuovo tool che Synaptica ha acquistato, e usandolo un pochino si scoprono belle cose. Tra cui il fatto che Embarcadero ha integrato delle funzioni cross per il supporto della compressione Zip direttamente nella RTL library. Nella libreria “System.Zip” sono presenti diversi metodi per gestire la compressione…
Leggi tutto

TIP del giorno UBUNTU : NAUTILUS e la barra Indirizzi (Nautilus address box)

per Ivan Revelli
in Articoli, Articoli, Articoli, Articoli, Articoli
on Febbraio 12, 2012

0

Quanti con le nuove versioni di Ubuntu si sono strincazzati perchè non riescono a scriver l’indirizzo (di un server remoto o di una location che sanno a memoria) perchè la barra degli indirizzi è stata sostituita da una specie di bottoniera naviga cartelle (a mio avviso di una scomodità totale). Beh nel caso vi serva…
Leggi tutto

Tip – [DELPHI] : Read windows environment variables

per Ivan Revelli
in Articoli
on Febbraio 10, 2012

0

this function that i found on the Net allow your delphi code to access at environment variables of your Windows systems :

function GetEnvVarValue(const VarName: string): string;
var
  BufSize: Integer;  // buffer size required for value
begin
  // Get required buffer size (inc. terminal #0)
  BufSize := GetEnvironmentVariable(
    PChar(VarName), nil, 0);
  if BufSize > 0 then
  begin
    // Read env var value into result string
    SetLength(Result, BufSize - 1);
    GetEnvironmentVariable(PChar(VarName),
      PChar(Result), BufSize);
  end
  else
    // No such environment variable
    Result := '';
end;

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

function GetEnvVarValue(const VarName: string): string;

var

BufSize: Integer; // buffer size required for value

begin

// Get required buffer size (inc. terminal #0)

BufSize := GetEnvironmentVariable(

PChar(VarName), nil, 0);

if BufSize > 0 then

begin

// Read env var value into result string

SetLength(Result, BufSize - 1);

GetEnvironmentVariable(PChar(VarName),

PChar(Result), BufSize);

end

else

// No such environment variable

Result := '';

end;

TIP [DELPHI] – Invio di una mail utilizzando il protocollo MAPI

per Ivan Revelli
in Senza categoria
on Gennaio 19, 2012

0

function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;

type  

TAttachAccessArray = array [0..0] of TMapiFileDesc;

PAttachAccessArray = ^TAttachAccessArray;  

var  

MapiMessage: TMapiMessage;  

Receip: TMapiRecipDesc;  

Attachments: PAttachAccessArray;  

AttachCount: Integer;  

i1: integer;  

FileName: string;  

dwRet: Cardinal;  

MAPI_Session: Cardinal;  

WndList: Pointer;  

begin  

dwRet := MapiLogon(Handle,  

PChar(''),  

PChar(''),

MAPI_LOGON_UI or MAPI_NEW_SESSION,  

0, @MAPI_Session);  


if (dwRet <> SUCCESS_SUCCESS) then  

begin  

MessageBox(Handle,  

PChar('Error while trying to send email'),  

PChar('Error'),  

MB_ICONERROR or MB_OK);

end

else  

begin  

FillChar(MapiMessage, SizeOf(MapiMessage), #0);  

Attachments := nil;  

FillChar(Receip, SizeOf(Receip), #0);  

if Mail.Values['to'] <> '' then

begin

Receip.ulReserved := 0;

Receip.ulRecipClass := MAPI_TO;

Receip.lpszName := StrNew(PChar(Mail.Values['to']));

Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['to']));

Receip.ulEIDSize := 0;

MapiMessage.nRecipCount := 1;

MapiMessage.lpRecips := @Receip;

end;


AttachCount := 0;


for i1 := 0 to MaxInt do

begin

if Mail.Values['attachment' + IntToStr(i1)] = '' then

break;

Inc(AttachCount);

end;


if AttachCount > 0 then

begin

GetMem(Attachments, SizeOf(TMapiFileDesc) * AttachCount);


for i1 := 0 to AttachCount - 1 do

begin

FileName := Mail.Values['attachment' + IntToStr(i1)];

Attachments[i1].ulReserved := 0;

Attachments[i1].flFlags := 0;

Attachments[i1].nPosition := ULONG($FFFFFFFF);

Attachments[i1].lpszPathName := StrNew(PChar(FileName));

Attachments[i1].lpszFileName :=

StrNew(PChar(ExtractFileName(FileName)));

Attachments[i1].lpFileType := nil;

end;

MapiMessage.nFileCount := AttachCount;

MapiMessage.lpFiles := @Attachments^;

end;


if Mail.Values['subject'] <> '' then

MapiMessage.lpszSubject := StrNew(PChar(Mail.Values['subject']));

if Mail.Values['body'] <> '' then

MapiMessage.lpszNoteText := StrNew(PChar(Mail.Values['body']));


WndList := DisableTaskWindows(0);

try

Result := MapiSendMail(MAPI_Session, Handle,

MapiMessage, MAPI_DIALOG, 0);

finally

EnableTaskWindows( WndList );

end;


for i1 := 0 to AttachCount - 1 do

begin

StrDispose(Attachments[i1].lpszPathName);

StrDispose(Attachments[i1].lpszFileName);

end;


if Assigned(MapiMessage.lpszSubject) then

StrDispose(MapiMessage.lpszSubject);

if Assigned(MapiMessage.lpszNoteText) then

StrDispose(MapiMessage.lpszNoteText);

if Assigned(Receip.lpszAddress) then

StrDispose(Receip.lpszAddress);

if Assigned(Receip.lpszName) then

StrDispose(Receip.lpszName);

MapiLogOff(MAPI_Session, Handle, 0, 0);

end;

End;

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;

type

TAttachAccessArray = array [0..0] of TMapiFileDesc;

PAttachAccessArray = ^TAttachAccessArray;

var

MapiMessage: TMapiMessage;

Receip: TMapiRecipDesc;

Attachments: PAttachAccessArray;

AttachCount: Integer;

i1: integer;

FileName: string;

dwRet: Cardinal;

MAPI_Session: Cardinal;

WndList: Pointer;

begin

dwRet := MapiLogon(Handle,

PChar(''),

MAPI_LOGON_UI or MAPI_NEW_SESSION,

0, @MAPI_Session);

if (dwRet <> SUCCESS_SUCCESS) then

begin

MessageBox(Handle,

PChar('Error while trying to send email'),

PChar('Error'),

MB_ICONERROR or MB_OK);

end

else

begin

FillChar(MapiMessage, SizeOf(MapiMessage), #0);

Attachments := nil;

FillChar(Receip, SizeOf(Receip), #0);

if Mail.Values['to'] <> '' then

begin

Receip.ulReserved := 0;

Receip.ulRecipClass := MAPI_TO;

Receip.lpszName := StrNew(PChar(Mail.Values['to']));

Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['to']));

Receip.ulEIDSize := 0;

MapiMessage.nRecipCount := 1;

MapiMessage.lpRecips := @Receip;

end;

AttachCount := 0;

for i1 := 0 to MaxInt do

begin

if Mail.Values['attachment' + IntToStr(i1)] = '' then

break;

Inc(AttachCount);

end;

if AttachCount > 0 then

begin

GetMem(Attachments, SizeOf(TMapiFileDesc) * AttachCount);

for i1 := 0 to AttachCount - 1 do

begin

FileName := Mail.Values['attachment' + IntToStr(i1)];

Attachments[i1].ulReserved := 0;

Attachments[i1].flFlags := 0;

Attachments[i1].nPosition := ULONG($FFFFFFFF);

Attachments[i1].lpszPathName := StrNew(PChar(FileName));

Attachments[i1].lpszFileName :=

StrNew(PChar(ExtractFileName(FileName)));

Attachments[i1].lpFileType := nil;

end;

MapiMessage.nFileCount := AttachCount;

MapiMessage.lpFiles := @Attachments^;

end;

if Mail.Values['subject'] <> '' then

MapiMessage.lpszSubject := StrNew(PChar(Mail.Values['subject']));

if Mail.Values['body'] <> '' then

MapiMessage.lpszNoteText := StrNew(PChar(Mail.Values['body']));

WndList := DisableTaskWindows(0);

try

Result := MapiSendMail(MAPI_Session, Handle,

MapiMessage, MAPI_DIALOG, 0);

finally

EnableTaskWindows( WndList );

end;

for i1 := 0 to AttachCount - 1 do

begin

StrDispose(Attachments[i1].lpszPathName);

StrDispose(Attachments[i1].lpszFileName);

end;

if Assigned(MapiMessage.lpszSubject) then

StrDispose(MapiMessage.lpszSubject);

if Assigned(MapiMessage.lpszNoteText) then

StrDispose(MapiMessage.lpszNoteText);

if Assigned(Receip.lpszAddress) then

StrDispose(Receip.lpszAddress);

if Assigned(Receip.lpszName) then

StrDispose(Receip.lpszName);

MapiLogOff(MAPI_Session, Handle, 0, 0);

end;

End;

Esempio di utilizzo della funzione :

mail.values['to'] := InputBox('Inserire l''indirizzo di posta del destinatario','Inserire l''indirizzo di posta del destinatario','');

mail.values['subject'] := 'Campagna : [' + InputBox('Nome Campagna','Nome Campagna','') + ']';

ts.Add('[<nome file>]');

ts.Add('[<User Name>]');

ts.add('');

ts.add('formato nome file : [DataOut_dd_mm_yy_ExportCount.zip]');

ts.add(' - "DataOut" <-- costante nome ');

ts.add(' - "dd_mm_yy" <-- formato data ');

ts.add(' - "_ExportCount" <-- contatore di esportazione utile nel caso di molteplici invii dello stesso file ');

mail.values['body'] := ts.Text;

mail.values['attachment0'] := OutFileName + '.zip';

// mail.values['attachment1']:='C:\Test2.txt';

{ TODO -oivan -cimportant : Inserire la procedura di gestione della mail }

sendEMail(Application.Handle, mail);

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

mail.values['to'] := InputBox('Inserire l''indirizzo di posta del destinatario','Inserire l''indirizzo di posta del destinatario','');

mail.values['subject'] := 'Campagna : [' + InputBox('Nome Campagna','Nome Campagna','') + ']';

ts.Add('[<nome file>]');

ts.Add('[<User Name>]');

ts.add('');

ts.add('formato nome file : [DataOut_dd_mm_yy_ExportCount.zip]');

ts.add(' - "DataOut" <-- costante nome ');

ts.add(' - "dd_mm_yy" <-- formato data ');

ts.add(' - "_ExportCount" <-- contatore di esportazione utile nel caso di molteplici invii dello stesso file ');

mail.values['body'] := ts.Text;

mail.values['attachment0'] := OutFileName + '.zip';

// mail.values['attachment1']:='C:\Test2.txt';

{ TODO -oivan -cimportant : Inserire la procedura di gestione della mail }

sendEMail(Application.Handle, mail);

TIP [DELPHI] – Inviare una mail utilizzando le classi Indy

per Ivan Revelli
in Senza categoria
on Gennaio 19, 2012

0

Piccolo esempio base, per l’invio di una mail utilizzando la classe Indy TidMessage :

 documentazione originale : 

{http://www.dragonsoftru.com/articles/indy-email.html#part_3_4}


function TDmMail.SendHtmlMessage(AddrFrom, AddrTo, Subject, Body,  AttachFiles: String): Boolean;
Var
 Idm     : TIdMessage;
 TSFiles : TStringList;
 IdA     : TIdAttachment;
 I       : Integer;
 lTextPart  : TIdText;
 lImagePart : TIdAttachment;
 
begin
 IdSMTP.Connect(4000);
 IdSMTP.Username := 'ivo il tardivo';
 Idm := TIdMessage.Create(Self);
 
 
 
 Idm.From.Address := 'myemail@mydomain.com';
 Idm.Subject := 'My test email';
 Idm.Recipients.Add.Address := 'someoneemail@somedomain.com';
 Idm.Body.Clear;
 lTextPart := TIdText.Create(Idm.MessageParts);
 lTextPart.Body.Text := 'This is a plain text message';
 lTextPart.ContentType := 'text/plain';
 lTextPart := TIdText.Create(Idm.MessageParts);
 lTextPart.Body.Text := '<html><body><center><b>This is a HTML message with picture</b><BR><img src="cid:02.JPG" ></center></body></html>';
 lTextPart.ContentType := 'text/html';
 lImagePart := TIdAttachment.Create(Idm.MessageParts, 'c:\02.JPG');
 lImagePart.ContentType := 'image/jpg';
 lImagePart.Headers.Add('Content-ID: <02.JPG>');
 IdSMTP.Send(Idm);
 IdSMPT.Disconnect;
end;

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

documentazione originale :

{http://www.dragonsoftru.com/articles/indy-email.html#part_3_4}

function TDmMail.SendHtmlMessage(AddrFrom, AddrTo, Subject, Body, AttachFiles: String): Boolean;

Var

Idm : TIdMessage;

TSFiles : TStringList;

IdA : TIdAttachment;

I : Integer;

lTextPart : TIdText;

lImagePart : TIdAttachment;

begin

IdSMTP.Connect(4000);

IdSMTP.Username := 'ivo il tardivo';

Idm := TIdMessage.Create(Self);

Idm.From.Address := 'myemail@mydomain.com';

Idm.Subject := 'My test email';

Idm.Recipients.Add.Address := 'someoneemail@somedomain.com';

Idm.Body.Clear;

lTextPart := TIdText.Create(Idm.MessageParts);

lTextPart.Body.Text := 'This is a plain text message';

lTextPart.ContentType := 'text/plain';

lTextPart := TIdText.Create(Idm.MessageParts);

lTextPart.Body.Text := '<html><body><center><b>This is a HTML message with picture</b><BR><img src="cid:02.JPG" ></center></body></html>';

lTextPart.ContentType := 'text/html';

lImagePart := TIdAttachment.Create(Idm.MessageParts, 'c:\02.JPG');

lImagePart.ContentType := 'image/jpg';

lImagePart.Headers.Add('Content-ID: <02.JPG>');

IdSMTP.Send(Idm);

IdSMPT.Disconnect;

end;

TIP [DELPHI] – Memoria occupata dall’applicazione in esecuzione

per Ivan Revelli
in Senza categoria
on Gennaio 19, 2012

0

Capita di creare applicazioni che fanno un uso intensivo della memoria, per poter calibrare alcuni processi all’interno dell’applicazione potrebbe essere conveniente conoscere l’impegno di memoria di quest’ultima, per fare ciò riporto di seguito un piccolo esempio :

Leggere la quantità di memoria occupata dalla ns applicazione da codice
 
{$R *.dfm}
uses psAPI;

function GetProcessMemorySize(var _nMemSize: Cardinal): Boolean;
var
  l_nWndHandle, l_nProcID, l_nTmpHandle: HWND;
  l_pPMC: PPROCESS_MEMORY_COUNTERS;
  l_pPMCSize: Cardinal;
begin
  // Permette di ricavere l'hadle dal nome del processo 
  // l_nWndHandle := FindWindow(nil, PChar(_sProcessName));
  
  // In questo caso imposto l'handle alla ns applicazione
  l_nWndHandle := Application.Handle;

  if l_nWndHandle = 0 then
  begin
    Result := False;
    Exit;
  end;

  l_pPMCSize := SizeOf(PROCESS_MEMORY_COUNTERS);

  GetMem(l_pPMC, l_pPMCSize);
  l_pPMC^.cb := l_pPMCSize;

  GetWindowThreadProcessId(l_nWndHandle, @l_nProcID);
  l_nTmpHandle := OpenProcess(PROCESS_ALL_ACCESS, False, l_nProcID);

  if (GetProcessMemoryInfo(l_nTmpHandle, l_pPMC, l_pPMCSize)) then
    _nMemSize := l_pPMC^.WorkingSetSize
  else
    _nMemSize := 0;

  FreeMem(l_pPMC);

  Result := True;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  l_nSize: Cardinal;
begin
  if (GetProcessMemorySize(l_nSize)) then
    ShowMessage('Size: ' + IntToStr(l_nSize) + ' byte')
  else
    ShowMessage('Error');
end;

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

Leggere la quantità di memoria occupata dalla ns applicazione da codice

{$R *.dfm}

uses psAPI;

function GetProcessMemorySize(var _nMemSize: Cardinal): Boolean;

var

l_nWndHandle, l_nProcID, l_nTmpHandle: HWND;

l_pPMC: PPROCESS_MEMORY_COUNTERS;

l_pPMCSize: Cardinal;

begin

// Permette di ricavere l'hadle dal nome del processo

// l_nWndHandle := FindWindow(nil, PChar(_sProcessName));

// In questo caso imposto l'handle alla ns applicazione

l_nWndHandle := Application.Handle;

if l_nWndHandle = 0 then

begin

Result := False;

Exit;

end;

l_pPMCSize := SizeOf(PROCESS_MEMORY_COUNTERS);

GetMem(l_pPMC, l_pPMCSize);

l_pPMC^.cb := l_pPMCSize;

GetWindowThreadProcessId(l_nWndHandle, @l_nProcID);

l_nTmpHandle := OpenProcess(PROCESS_ALL_ACCESS, False, l_nProcID);

if (GetProcessMemoryInfo(l_nTmpHandle, l_pPMC, l_pPMCSize)) then

_nMemSize := l_pPMC^.WorkingSetSize

else

_nMemSize := 0;

FreeMem(l_pPMC);

Result := True;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

l_nSize: Cardinal;

begin

if (GetProcessMemorySize(l_nSize)) then

ShowMessage('Size: ' + IntToStr(l_nSize) + ' byte')

else

ShowMessage('Error');

end;

Autore: Ivan Revelli

Delphi XE2 – Native compression support “ZIP” & “UNZIP”

TIP del giorno UBUNTU : NAUTILUS e la barra Indirizzi (Nautilus address box)

Tip – [DELPHI] : Read windows environment variables

TIP [DELPHI] – Invio di una mail utilizzando il protocollo MAPI

TIP [DELPHI] – Inviare una mail utilizzando le classi Indy

TIP [DELPHI] – Memoria occupata dall’applicazione in esecuzione

Ricerca Articolo

Categorie

Synaptica srl