1:
2:
3:
4:
5:

[Warnung] comm_async.pas(153): Symbol 'AllocateHWnd' ist veraltet
[Warnung] comm_async.pas(182): Symbol 'DeallocateHWnd' ist veraltet
[Fehler] Helper.pas(400): Bei der vorherigen Deklaration von AddToLog wurde die Direktive 'overload' nicht angegeben
[Fehler] Helper.pas(30): Ungenügende Forward- oder External-Deklaration: 'AddToLog'
[Fataler Fehler] FServiceSK_M.pas(200): Verwendete Unit '..\ServiceTools_Shared\Component\Helper.pas' kann nicht compiliert werden					

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:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:

unit Helper;

interface

uses Types, Classes, XMLIntf, QStdCtrls, TLoggerUnit,
  UnitConstantsGeneral;

function ReadPipeToString(const hPipe: THandle ): String;
function CallDOSCommand( command: String; waitForCmd: Integer = -1 ): String;
function dbuToV( dbu: Real ): Real;
function VToDbu( v: Real ): Real;
function dbmToV( dbm: Real ): Real;
function VToDbm( v: Real ): Real;
function RoundBeforeComma( value: real; significantDigits: Integer ): Real;
function RoundBeforeCommaInt( value: real; significantDigits: Integer ): Integer;
function StrToFloatTolerant( text: String ): Real;
function VoltageToString( v: Real ): String;
function ConvertFreqValue( text: String; low, hi, step_min: Cardinal ): Cardinal; overload;
function ConvertFreqValue( freq: Integer ): String; overload;
function GetBuildNumber( Filename: String ): String;
procedure ParseIPAddress( var data: array of Cardinal; address: String );
function FindUsableScreenRect: TRect;
procedure SaveIntArrayToDataStore( data: TIntArray; node: IXMLNode ); overload;
procedure SaveIntArrayToDataStore( data: TShortIntArray; node: IXMLNode ); overload;
procedure SaveDateTimeArrayToDataStore( data: TDateTimeArray; node: IXMLNode );
procedure LoadIntArrayFromDataStore( var data: TIntArray; node: IXMLNode ); overload;
procedure LoadIntArrayFromDataStore( var data: TShortIntArray; node: IXMLNode ); overload;
procedure LoadDateTimeArrayFromDataStore( var data: TDateTimeArray; node: IXMLNode );
function PrintCmdBytes( data: array of Byte ): String;
procedure AddToLog( line: String; memo: TMemo; logger: TLogger );
{procedure AddToLogX( data: TStrings; memo: TMemo; logger: TLogger );}

const
  MEM_CHUNK_SIZE                      = 8192;
  WAIT_FOR_CMD                        = 500;
  STR_KHZ_POSTFIX                     = ' kHz';
  STR_MHZ_POSTFIX                     = ' MHz';
  STR_DBM_POSTFIX                     = ' dbm';
  STR_PERCENT_POSTFIX                 = ' %';

implementation

uses Windows, Messages, SysUtils, Variants, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls, ComCtrls, Buttons, Math, StrUtils;

{*******************************************************************************
*** Stream functions
*******************************************************************************}
// Pipe in einen String auslesen (speicherschonend)
function ReadPipeToString(const hPipe: THandle ): String;
var
  NumberOfBytesRead, NumberOfBytesTotal: Cardinal;
begin
  Result := ''; // Standard-Ergebnis
  NumberOfBytesTotal := 0; // noch nichts gelesen
  repeat
    SetLength( Result, Length( Result ) + MEM_CHUNK_SIZE ); // mehr Platz machen
    // versuchen, aus der Pipe zu lesen
    if ReadFile( hPipe,( @Result[ 1 + NumberOfBytesTotal] )^, MEM_CHUNK_SIZE,
                NumberOfBytesRead, NIL ) then // hat geklappt
      Inc( NumberOfBytesTotal, NumberOfBytesRead ); // Gesamtanzahl aktualisieren
    SetLength( Result, NumberOfBytesTotal ); // überzählige Bytes abschneiden
  until ( NumberOfBytesRead = 0 ); // bis die Pipe leer ist
end;
{*******************************************************************************
*** CallDosCommand
*******************************************************************************}
function CallDOSCommand( command: String; waitForCmd: Integer = -1 ): String;
var
  Created: Boolean;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  PipeOutputRead, PipeOutputWrite: THandle;
begin
  // Win-API-Strukturen initialisieren/füllen
  FillChar( ProcessInfo, SizeOf( TProcessInformation ), 0 );
  FillChar( SecurityAttr, SizeOf( TSecurityAttributes ), 0 );
  FillChar( StartupInfo, SizeOf( TStartupInfo ), 0 );
  SecurityAttr.nLength := SizeOf( SecurityAttr );
  SecurityAttr.bInheritHandle := TRUE;
  SecurityAttr.lpSecurityDescriptor := NIL;
  CreatePipe( PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0 );
  StartupInfo.cb := SizeOf( StartupInfo );
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := PipeOutputWrite;
  StartupInfo.wShowWindow := SW_HIDE;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  Created := CreateProcess( NIL, PChar( command ), NIL, NIL, TRUE,
    CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
    NIL, NIL, StartupInfo, ProcessInfo );
  if ( waitForCmd < 0 ) then    Sleep( WAIT_FOR_CMD )
  else                          Sleep( waitForCmd );
  TerminateProcess( ProcessInfo.hProcess, 0 );
  CloseHandle( PipeOutputWrite );
  if ( Created ) then begin // konnte der Befehl ausgeführt werden?
    Result := ReadPipeToString( PipeOutputRead ); // Ausgabe-Read-Pipe auslesen
    //GetExitCodeProcess( ProcessInfo.hProcess, AExitCode ); // http://msdn2.microsoft.com/en-us/library/ms683189.aspx
    CloseHandle( ProcessInfo.hProcess ); // und Handle freigeben
  end;
  CloseHandle( PipeOutputRead );
end;
{*******************************************************************************
*** Unit calculations
*******************************************************************************}
function dbuToV( dbu: Real ): Real;
begin
  Result := Power( 10, ( dbu / 20 ) ) * 0.775;
end;
function VToDbu( v: Real ): Real;
begin
  Result := Log10( v / 0.775 ) * 20;
end;
function dbmToV( dbm: Real ): Real;
begin
  Result := Power( 10, ( dbm / 20 ) ) * 0.225;
end;
function VToDbm( v: Real ): Real;
begin
  Result := Log10( v / 0.225 ) * 20;
end;
{*******************************************************************************
*** Mathematical calculation
*******************************************************************************}
function RoundBeforeComma( value: real; significantDigits: Integer ): Real;
var
  stellen: Integer;
  fact: Real;
begin
  if ( value = 0 ) then       stellen := 1
  else                        stellen := Floor( Log10( Abs( value ) ) ) + 1;
  fact := Power( 10, Max( stellen - Max( significantDigits, 0 ), 0 ) );
  Result := Round( value / fact ) * fact;
end;
function RoundBeforeCommaInt( value: real; significantDigits: Integer ): Integer;
begin
  Result := Round( RoundBeforeComma( value, significantDigits ) );
end;
{*******************************************************************************
*** String processing
*******************************************************************************}
function StrToFloatTolerant( text: String ): Real;
var
  text2: String;
  A: Integer;
begin
  text2 := '';
  for A := 1 to Length( text ) do begin
    if (  ( '0' <= Char( text[ A ] ) ) AND ( Char( text[ A ] ) <= '9' ) ) then
      text2 := text2 + Char( text[ A ] );
    if ( ( Char( text[ A ] ) = '.' ) OR ( Char( text[ A ] ) = ',' ) ) then
      text2 := text2 + ',';
    if ( Char( text[ A ] ) = '-' ) then
      text2 := text2 + '-';
  end;

  Result := StrToFloat( text2 );
end;
function VoltageToString( v: Real ): String;
begin
  v := v * 1000000000;
  v := RoundBeforeComma( v, 3 ) / 1000000000;
  Result := FloatToStr( v ) + ' V';
  if ( v < 1 ) then
    Result := FloatToStr( v * 1000 ) + ' mV';
  if ( v < 0.001 ) then
    Result := FloatToStr( v * 1000000 ) + ' µV';
  if ( v < 0.000001 ) then
    Result := FloatToStr( v * 1000000000 ) + ' nV';
end;
{*******************************************************************************
*** Miscellaneous
*******************************************************************************}
function ConvertFreqValue( text: String; low, hi, step_min: Cardinal ): Cardinal; overload;
var
  v: Real;
begin
  v := StrToFloatTolerant( text );
  if ( ( Pos( '.', text ) > 0 ) OR ( Pos( ',', text ) > 0 ) OR ( v < 1000 ) )  then
    v := v * 1000;
  v := Round( v / step_min ) * step_min;
  if NOT( ( -1 < v ) AND ( v < 1 ) ) then begin
    if ( v < low ) then    v := low;
    if ( v > hi  ) then    v := hi;
  end;
  Result := Round( v );
end;
// Negative values allowed, so we need to have the frequency being an integer
function ConvertFreqValue( freq: Integer ): String; overload;
var
  text: String;
  neg: Boolean;
begin
  neg := freq < 0;
  freq := Abs( freq );
  if ( freq < 1000 ) then begin
    text := IntToStr( freq );
    text := text + STR_KHZ_POSTFIX;
  end else if ( freq < 10000 ) then begin
         text := IntToStr( freq );
         text := MidStr( text, 1, 1 ) + '.' + MidStr( text, 2, 3 ) + STR_MHZ_POSTFIX;
       end else if ( freq < 100000 ) then begin
              text := IntToStr( freq );
              text := MidStr( text, 1, 2 ) + '.' + MidStr( text, 3, 3 ) + STR_MHZ_POSTFIX;
            end else begin
              text := IntToStr( freq );
              text := MidStr( text, 1, 3 ) + '.' + MidStr( text, 4, 3 ) + STR_MHZ_POSTFIX;
            end;
  if ( neg ) then
    text := '-' + text;
  Result := text;
end;
{*******************************************************************************
*** GetBuildNumber
*******************************************************************************}
function GetBuildNumber( Filename: String ): String;
type
  thilo=record
    case integer of
      0: (all:dword);
      1: (lo:word;hi:word);
    end;
var
  buffer:pointer;
  dummy:cardinal;
  size:cardinal;
  p:pointer;
  data:^vs_FIXEDFILEINFO;
  hilo:thilo;
  lastpointindex:integer;
begin
  result:='';
  size:=GetFileVersionInfoSize( pchar( filename ), dummy );
  GetMem( buffer, size );
  try
    if not GetFileVersionInfo( pchar( application.exename ), 0, size, buffer ) then begin
      result := '';
      exit;
    end;
    p := nil;
    if not VerQueryValue( buffer, pchar( '' ), p, size ) then begin
     result := '';
     exit;
    end;
    data := p;
    hilo.all := data^.dwFileVersionms;
    result := IntToStr( hilo.hi );
    result := result + '.' + IntToStr( hilo.lo );
    hilo.all := data^.dwFileVersionls;
    result := result + '.' + IntToStr( hilo.hi );
    result := result + '.' + IntToStr( hilo.lo );
  finally
    FreeMem( buffer );
  end;

  result :=  ReverseString( result );
  lastpointindex := Length( result ) - Pos( '.', result ) + 1;
  result :=  ReverseString( result );
  result := Copy( result, lastpointindex + 1, Length( result ) - lastpointindex );
end;
procedure ParseIPAddress( var data: array of Cardinal; address: String );
var
  b, c: Integer;
begin
//  SetLength( data, 4 );
  b := Pos( '.', address );
  data[ 0 ] := StrToIntDef( AnsiLeftStr( address, b - 1 ), 0 );
  b := b + 1;
  c := PosEx( '.', address, b );
  data[ 1 ] := StrToIntDef( AnsiMidStr( address, b, c - b ), 0 );
  b := c + 1;
  c := PosEx( '.', address, b );
  data[ 2 ] := StrToIntDef( AnsiMidStr( address, b, c - b ), 0 );
  b := c + 1;
  c := Length( address ) + 1;
  data[ 3 ] := StrToIntDef( AnsiMidStr( address, b, c - b ), 0 );
end;
function FindUsableScreenRect: TRect;
var
  wnd: HWnd;
  rect: TRect;
begin
  wnd:= FindWindow( 'Shell_TrayWnd', nil );
  if ( wnd <> 0 ) then begin
    GetWindowRect( wnd, rect);
    Result.Top := 0;
    Result.Left := 0;
    Result.Bottom := Screen.Height;
    Result.Right := Screen.Width;
    if ( ( rect.Bottom - rect.Top ) < Screen.Height ) then begin
      // Taskbar at top or bottom
      if ( rect.Top = 0 ) then      Result.Top := rect.Bottom // At top
      else                          Result.Bottom := rect.Top; // At bottom
    end else begin
      // Taskbar at left or right
      if ( rect.Left = 0 ) then     Result.Left := rect.Right // At left
      else                          Result.Right := rect.Left; // At reight
    end;
  end else begin
    Result.Top    := 0;
    Result.Left   := 0;
    Result.Bottom := Screen.Height;
    Result.Right  := Screen.Width;
  end;
end;
procedure SaveIntArrayToDataStore( data: TIntArray; node: IXMLNode );
var
  line: String;
  idx: Integer;
begin
  node.SetAttribute( 'Count', Length( data ) );
  line := '';
  for idx := 0 to High( data ) do
    line := line + IntToStr( data[ idx ] ) + CSV_XML_DELIMITER;
  node.Text := line;
end;
procedure SaveIntArrayToDataStore( data: TShortIntArray; node: IXMLNode );
var
  line: String;
  idx: Integer;
begin
  node.SetAttribute( 'Count', Length( data ) );
  line := '';
  for idx := 0 to High( data ) do
    line := line + IntToStr( data[ idx ] ) + CSV_XML_DELIMITER;
  node.Text := line;
end;
procedure SaveDateTimeArrayToDataStore( data: TDateTimeArray; node: IXMLNode );
var
  line: String;
  idx: Integer;
begin
  node.SetAttribute( 'Count', Length( data ) );
  line := '';
  for idx := 0 to High( data ) do
    line := line + DateTimeToStr( data[ idx ] ) + CSV_XML_DELIMITER;
  node.Text := line;
end;
procedure LoadIntArrayFromDataStore( var data: TIntArray; node: IXMLNode );
var
  line: String;
  idx, p1, p2: Integer;
begin
  SetLength( data, Integer( node.GetAttribute( 'Count' ) ) );
  line := node.Text;
  p2 := 0;
  for idx := 0 to High( data ) do begin
    p1 := p2 + 1;
    p2 := PosEx( CHAR_COMMA, line, p1 );
    data[ idx ] := StrToIntDef( MidStr( line, p1, p2 - p1 ), 0 );
  end;
end;
procedure LoadIntArrayFromDataStore( var data: TShortIntArray; node: IXMLNode );
var
  line: String;
  idx, p1, p2: Integer;
begin
  SetLength( data, Integer( node.GetAttribute( 'Count' ) ) );
  line := node.Text;
  p2 := 0;
  for idx := 0 to High( data ) do begin
    p1 := p2 + 1;
    p2 := PosEx( CHAR_COMMA, line, p1 );
    data[ idx ] := StrToIntDef( MidStr( line, p1, p2 - p1 ), 0 );
  end;
end;
procedure LoadDateTimeArrayFromDataStore( var data: TDateTimeArray; node: IXMLNode );
var
  line: String;
  idx, p1, p2: Integer;
begin
  SetLength( data, Integer( node.GetAttribute( 'Count' ) ) );
  line := node.Text;
  p2 := 0;
  for idx := 0 to High( data ) do begin
    p1 := p2 + 1;
    p2 := PosEx( CHAR_COMMA, line, p1 );
    data[ idx ] := StrToDateTimeDef( MidStr( line, p1, p2 - p1 ), 0 );
  end;
end;

function PrintCmdBytes(data: array of Byte): String;
var
  b: Integer;
begin
  Result := Format( 'CMD byte: %.2x', [ data[ 0 ] ] );
  b := 1;
  while ( b < Length( data ) ) do begin
    if ( b MOD 20 = 1 ) then
      Result := Result + STR_NEWLINE;
    if ( b MOD 10 = 1 ) AND ( b MOD 20 <> 1 ) then
      Result := Result + '          ';
    if ( b MOD 10 = 1 ) then
      Result := Result + Format( 'Byte %.3d: ', [ b ] );
    Result := Result + Format( ' %.2x', [ data[ b ] ] );
    b := b + 1;
  end;
end;

procedure AddToLog( line: String; memo: TMemo; logger: TLogger );
var
  x, Hour, Min, Sec, MSec: Word;
begin
  x := Pos( STR_NEWLINE, line );
  if ( x > 0 ) then begin
{    AddToLog( LeftStr( line, x - 1 ), memo, logger );
    AddToLog( RightStr( line, Length( line ) - x - 1 ), memo, logger );}
  end else begin
    DecodeTime( Now, Hour, Min, Sec, MSec);
    line := Format( '(%.2d:%.2d:%.2d,%.3d) %s', [ Hour, Min, Sec, MSec, line ] );
    logger.Debug( line );
    TMemo( memo ).Lines.Add( line );
  end;
end;

{procedure AddToLog( data: TStrings; memo: TMemo; logger: TLogger ); overload;
var
  a: Integer;
begin
  for a := 0 to data.Count - 1 do
    AddToLog( data[ a ], memo, logger );
end; }
end.