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
|
{$IFDEF BIN_IMPORT_}
var
qhfver: byte;
szMsgHd: word;
UIDstr: UTF8String;
UIDLen, NickLen: word;
NickStr: UTF8String;
function DecodeQHFMsg(ver: byte; adr: integer; cSize: word): AnsiString;
function get1(c: AnsiChar): byte;
begin
if ShortInt(c) >= 0 then
Result := byte(c)
else
Result := byte(c) + 256;
end;
function get2(b: byte): AnsiChar;
begin
if b < 128 then
Result := AnsiChar(b)
else
Result := AnsiChar(b - 256);
end;
var
i: integer;
begin
SetLength(Result, cSize);
for i := 1 to cSize do
begin
Result[i] := PAnsiChar(adr + i - 1)^;
if ver <> $01 then
begin
inc(Result[i], i);
Result[i] := get2(255 - get1(Result[i]));
end
end;
end;
{$ELSE}
begin
pt := uint_ptr(pFileText);
if FileLen >= $2E then
if (PAnsiChar(pt)^ = 'Q') and (PAnsiChar(pt + 1)^ = 'H') and (PAnsiChar(pt + 2)^ = 'F') then
begin
qhfver := PByte(pt + 3)^;
if qhfver >= $03 then
szMsgHd := $23
else
szMsgHd := $21;
fsz := RLInteger(pt + $04);
UIDLen := RLWord(pt + $2C);
SetLength(UIDstr, UIDLen);
if qhfver <= 2 then
lstrcpynA(PAnsiChar(UIDstr), PAnsiChar(pt + $2E), UIDLen)
else
lstrcpynA(PAnsiChar(UIDstr), PAnsiChar(pt + $2E), UIDLen + 1);
NickLen := RLWord(pt + $2E + UIDLen);
SetLength(NickStr, NickLen);
if qhfver <= 2 then
lstrcpynA(PAnsiChar(NickStr), PAnsiChar(pt + $2E + UIDLen + 2), UIDLen)
else
lstrcpynA(PAnsiChar(NickStr), PAnsiChar(pt + $2E + UIDLen + 2), UIDLen + 1);
inc(pt, $2E + UIDLen + 2 + NickLen);
if fsz <> FileLen - ($2E + UIDLen + 2 + NickLen) then
fsz := FileLen - ($2E + UIDLen + 2 + NickLen);
if (DContact.hContact = 0) or (DContact.hContact = INVALID_HANDLE_VALUE)
then
begin
DContact.ContactUID := UIDstr;
DContact.ContactNick := UTF8Decode{UTF8ToWideString}(NickStr);
TryDetermContact(DContact);
end;
if (DContact.hContact = 0) or (DContact.hContact = INVALID_HANDLE_VALUE) then
if (fContact.hContact <> 0) and (fContact.hContact <> INVALID_HANDLE_VALUE) then
DContact := fContact;
if (DContact.hContact <> 0) and (DContact.hContact <> INVALID_HANDLE_VALUE) then
begin
proto := GetContactProto(DContact.hContact);
DoMessage(ITXT_THREAD_DEST_CONTACT, DContact.hContact, 0);
DoMessage(ITXT_THREAD_START, 0, 0);
DoMessage(ITXT_THREAD_MAXPROGRESS, 0, fsz);
i := 0;
while Cardinal(i) < fsz do
begin
fillchar(dbei, sizeof(dbei), 0);
dbei.cbSize := sizeof(dbei);
dbei.szModule := PAnsiChar(proto);
dbei.timestamp := RLInteger(pt + i + $12);
dbei.timestamp := dbei.timestamp -
(Cardinal(CallService(MS_DB_TIME_TIMESTAMPTOLOCAL, dbei.timestamp, 0)) - dbei.timestamp); // ïðèâîäèì ê GMT
if PByte(pt + i + $1A)^ = $00 then
dbei.flags := DBEF_READ or DBEF_UTF
else
dbei.flags := DBEF_READ or DBEF_UTF or DBEF_SENT;
// â ôàéëàõ ëåæàò â utf8 è èìïîðòèðóþòñÿ áåç èçìåíåíèé
dbei.eventType := EVENTTYPE_MESSAGE;
dbei.cbBlob := RLWord(pt + i + szMsgHd - 2) + 1;
// ðàçìåð òåêñòà ñîîáùåíèÿ ñ #0
dbei.pBlob := AllocMem(dbei.cbBlob);
try
Move(DecodeQHFMsg(qhfver, pt + i + szMsgHd, dbei.cbBlob - 1)[1],
dbei.pBlob^, dbei.cbBlob - 1);
if not IsDuplicateEvent(DContact.hContact, dbei) then
if db_event_add(DContact.hContact, @dbei) <> 0 then
inc(AddedMessages)
else
begin
s := 'Error adding message to database';
DoMessage(ITXT_THREAD_ERROR, wparam(PWideChar(s)), 0);
break;
end
else
inc(Duplicates);
finally
inc(i, szMsgHd + dbei.cbBlob - 1);
FreeMem(dbei.pBlob);
end;
DoMessage(ITXT_THREAD_PROGRESS, i, 0);
end;
end
else
begin
s := TranslateWideString('Can''t determine destination contact');
DoMessage(ITXT_THREAD_ERROR, wparam(PWideChar(s)), 0);
end;
end
else
begin
s := WideFormat(TranslateWideString('It''s not %s file'), ['QHF']);
DoMessage(ITXT_THREAD_ERROR, wparam(PWideChar(s)), 0);
end
else // file len
end;
{$ENDIF}
|
