Esempio SPPSERV/Sviluppo scadenze/delphi

Da SIGLAkb.

Dp-ingranaggio3.png Questo esempio illustra come utilizzare le funzioni della SPPSERV.DLL per calcolare le scadenze a partire da un codice di pagamento. L'esempio è stato sviluppato in Delphi e compilato con Delphi versione 7.

Prima di utilizzare questo esempio è necessario modificare opportunamente alcuni dati come le stringhe di connessione ai database dei dati comuni e ditta, il codice pagamento, le date ecc..

Dp-acceptn72x72.png Questo sorgente è fornito a titolo di esempio come dimostrazione dell'utilizzo della libreria SPPSERV.DLL. Nessuna garanzia, né implicita né esplicita, è prevista per qualsiasi utilizzo diverso da quello indicato.
 
 
 (* --------------------------------------------------------------------------------
  *
  * Programma di esempio per la registrazione di una fattura di vendita utilizzando
  * le funzioni della libreria SPPSERV.DLL.
  * Prima di utilizzare questo esempio è necessario modificare alcune informazioni
  * in modo da adattare il codice alla base dati utilizzata.
  *
  * In questo esempio l'esercizio di lavoro e' considerato corrispondente all'anno
  * solare in corso e le date impostate per default a quella attuale.
  *
  * QUESTO SORGENTE E' FORNITO A TITOLO DI ESEMPIO COME DIMOSTRAZIONE DELL'UTILIZZO
  * DELLA LIBRERIA SPPSERV.DLL. NESSUNA GARANZIA, NE' IMPLICITA NE' ESPLICITA, E'
  * PREVISTA PER QUALSIASI UTILIZZO DIVERSO DA QUELLO INDICATO.
  *
  -------------------------------------------------------------------------------- *)
 program SppServTest3;
 
 {$APPTYPE CONSOLE}
 
 uses
  Windows, StdCtrls, ExtCtrls, SysUtils;
 
 const
  MY_LIBRARY_NAME = 'sppserv.dll';
  SPPSRV_SUCCESS = 0;
 
 type
  PDouble = ^double;
 
 var
  // prototipi delle funzioni della sppserv.dll
  SPPSRVVersion  : function() : integer stdcall;
  SPPSRVInit  : function(mainwnd : HWND) : integer stdcall;
  SPPSRVExit  : function() : integer stdcall;
  SPPSRVComuniConnect  : function(comuniconnectstring : pChar) : integer stdcall;
  SPPSRVDittaConnect  : function(dittaconnectstring : pChar) : integer stdcall;
  SPPSRVSetEsercizio  : function(esercizio : pChar) : integer stdcall;
  SPPSRVSetEuro  : function(IsEuro : boolean) : integer stdcall;
  SPPSRVSetUtente  : function(utente : pChar) : integer stdcall;
  SPPSRVSetTodayDate  : function(todaydate : pChar) : integer stdcall;
  SPPSRVCalcolaScadenze  : function(tipopag : pChar; IsValuta : boolean; TRata : double;
  DataFattura : pChar; datadecpag : pChar;
  ggpart : pChar; msalto1 : pChar; msalto2 : pChar;
  ggsalto : pChar) : integer stdcall;
  SPPSRVReadScadenza  : function(nscad : integer; importo : PDouble; data : pChar;
  tipo : pChar) : integer stdcall;
 
  dll : THandle;
  IsError, rc, numscad, j : integer;
  tipopag,DataFattura, datadecpag, ggpart,
  msalto1, msalto2, ggsalto : string;
  TRata, importo : double;
  IsValuta : boolean;
  tipo, dt1: array[0..16] of Char;
 
 label
  END_OF_TEST, FINE;
 
  procedure ReportError(Msg : string);
  var
  lpMsgBuf : pAnsiChar;
  ErrorCode : DWORD;
  begin
  GetMem(lpMsgBuf, 512);
  ErrorCode := GetLastError();
  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
  nil, ErrorCode, LANG_NEUTRAL, lpMsgBuf, 512, nil);
  WriteLn(Msg + ': errore ' + IntToStr(ErrorCode) + ' (' + lpMsgBuf + ')');
  FreeMem(lpMsgBuf);
  end;
 
 begin
  WriteLn('Inizio test ' + MY_LIBRARY_NAME);
  WriteLn('---------------------------------------------------');
  WriteLn('Caricamento DLL e estrazione funzioni...');
  dll := LoadLibrary(MY_LIBRARY_NAME);
  if (dll > 0) then
  WriteLn(MY_LIBRARY_NAME + ' caricata con successo')
  else begin
  WriteLn('**********************************************');
  WriteLn('ERRORE: LoadLibrary("' + MY_LIBRARY_NAME + '") fallita!');
  ReportError('Dettagli');
  WriteLn('**********************************************');
  goto END_OF_TEST;
  end;
  // estrazione delle funzioni esportate dalla dll
  IsError := 0;
  @SPPSRVInit := GetProcAddress(dll, 'SPPSRVInit');
  if (Assigned(SPPSRVInit)) then
  WriteLn('SPPSRVInit caricata con successo')
  else begin
  WriteLn('**************************************************************');
  WriteLn('ERRORE: GetProcAddress(dll, "SPPSRVInit") fallita!');
  WriteLn('**************************************************************');
  IsError := 1;
  end;
  @SPPSRVVersion := GetProcAddress(dll, 'SPPSRVVersion');
  if (Assigned(SPPSRVVersion)) then
  WriteLn('SPPSRVVersion caricata con successo')
  else begin
  WriteLn('**************************************************************');
  WriteLn('ERRORE: GetProcAddress(dll, "SPPSRVVersion") fallita!');
  WriteLn('**************************************************************');
  IsError := 1;
  end;
  @SPPSRVExit := GetProcAddress(dll, 'SPPSRVExit');
  if (Assigned(SPPSRVExit)) then
  WriteLn('SPPSRVExit caricata con successo')
  else begin
  WriteLn('**************************************************************');
  WriteLn('ERRORE: GetProcAddress(dll, "SPPSRVExit") fallita!');
  WriteLn('**************************************************************');
  IsError := 1;
  end;
  @SPPSRVComuniConnect := GetProcAddress(dll, 'SPPSRVComuniConnect');
  if (Assigned(SPPSRVComuniConnect)) then
  WriteLn('SPPSRVComuniConnect caricata con successo')
  else begin
  WriteLn('**************************************************************');
  WriteLn('ERRORE: GetProcAddress(dll, "SPPSRVComuniConnect") fallita!');
  WriteLn('**************************************************************');
  IsError := 1;
  end;
  @SPPSRVDittaConnect := GetProcAddress(dll, 'SPPSRVDittaConnect');
  if (Assigned(SPPSRVDittaConnect)) then
  WriteLn('SPPSRVDittaConnect caricata con successo')
  else begin
  WriteLn('**************************************************************');
  WriteLn('ERRORE: GetProcAddress(dll, "SPPSRVDittaConnect") fallita!');
  WriteLn('**************************************************************');
  IsError := 1;
  end;
  @SPPSRVSetEsercizio := GetProcAddress(dll, 'SPPSRVSetEsercizio');
  if (Assigned(SPPSRVSetEsercizio)) then
  WriteLn('SPPSRVSetEsercizio caricata con successo')
  else begin
  WriteLn('**************************************************************');
  WriteLn('ERRORE: GetProcAddress(dll, "SPPSRVSetEsercizio") fallita!');
  WriteLn('**************************************************************');
  IsError := 1;
  end;
  @SPPSRVSetUtente := GetProcAddress(dll, 'SPPSRVSetUtente');
  if (Assigned(SPPSRVSetUtente)) then
  WriteLn('SPPSRVSetUtente caricata con successo')
  else begin
  WriteLn('**************************************************************');
  WriteLn('ERRORE: GetProcAddress(dll,\"" << "SPPSRVSetUtente" << "\") fallita!');
  WriteLn('**************************************************************');
  IsError := 1;
  end;
  @SPPSRVSetTodayDate := GetProcAddress(dll, 'SPPSRVSetTodayDate');
  if (Assigned(SPPSRVSetTodayDate)) then
  WriteLn('SPPSRVSetTodayDate caricata con successo')
  else begin
  WriteLn('**************************************************************');
  WriteLn('ERRORE: GetProcAddress(dll,\"" << "SPPSRVSetTodayDate" << "\") fallita!');
  WriteLn('**************************************************************');
  IsError := 1;
  end;
  @SPPSRVSetEuro := GetProcAddress(dll, 'SPPSRVSetEuro');
  if (Assigned(SPPSRVSetEuro)) then
  WriteLn('SPPSRVSetEuro caricata con successo')
  else begin
  WriteLn('**************************************************************');
  WriteLn('ERRORE: GetProcAddress(dll, "SPPSRVSetEuro") fallita!');
  WriteLn('**************************************************************');
  IsError := 1;
  end;
  @SPPSRVCalcolaScadenze := GetProcAddress(dll, 'SPPSRVCalcolaScadenze');
  if (Assigned(SPPSRVCalcolaScadenze)) then
  WriteLn('SPPSRVCalcolaScadenze caricata con successo')
  else begin
  WriteLn('**************************************************************');
  WriteLn('ERRORE: GetProcAddress(dll, "SPPSRVCalcolaScadenze") fallita!');
  WriteLn('**************************************************************');
  IsError := 1;
  end;
  @SPPSRVReadScadenza := GetProcAddress(dll, 'SPPSRVReadScadenza');
  if (Assigned(SPPSRVReadScadenza)) then
  WriteLn('SPPSRVReadScadenza caricata con successo')
  else begin
  WriteLn('**************************************************************');
  WriteLn('ERRORE: GetProcAddress(dll, "SPPSRVReadScadenza") fallita!');
  WriteLn('**************************************************************');
  IsError := 1;
  end;
  if (IsError = 1) then goto END_OF_TEST;
 
  WriteLn('Test calcolo e lettura scadenze...');
  // inizializzazione della DLL
  rc := SPPSRVInit(GetDesktopWindow());
  WriteLn('SPPSRVInit ha tornato: ' + IntToStr(rc));
  if (rc <> SPPSRV_SUCCESS) then goto END_OF_TEST;
  // numero di versione della dll
  rc := SPPSRVVersion();
  WriteLn('SPPSRVVersion ha tornato: ' + IntToStr(rc));
  // connessione al database dei dati comuni e dei dati ditta
  {$ifdef STARTSUITE}
  // versione per SIGLA StartSuite (archivi dui tipo DBF)
  rc := SPPSRVComuniConnect('C:\SIGLAPP\PROVGEN');
  WriteLn('SPPSRVComuniConnect ha tornato: ' + IntToStr(rc));
  if (rc <> SPPSRV_SUCCESS) then goto FINE;
  rc := SPPSRVDittaConnect('C:\SIGLAPP\PROVDIT');
  WriteLn('SPPSRVDittaConnect ha tornato: ' + IntToStr(rc));
  if (rc <> SPPSRV_SUCCESS) then goto FINE;
  {$else}
  // versione per SIGLA (accesso ai dati via ODBC)
  rc := SPPSRVComuniConnect('DSN=pgSPPGEN;UID=sigla;PWD=sigla');
  WriteLn('SPPSRVComuniConnect ha tornato: ' + IntToStr(rc));
  if (rc <> SPPSRV_SUCCESS) then goto FINE;
  rc := SPPSRVDittaConnect('DSN=pgSPPDIT;UID=sigla;PWD=sigla');
  WriteLn('SPPSRVDittaConnect ha tornato: ' + IntToStr(rc));
  if (rc <> SPPSRV_SUCCESS) then goto FINE;
  {$endif}
  // impostazione dell'esercizio di lavoro
  rc := SPPSRVSetEsercizio(pChar(FormatDateTime('yyyy', Date)));
  WriteLn('SPPSRVSetEsercizio ha tornato: ' + IntToStr(rc));
  // impostazione dell'utente
  rc := SPPSRVSetUtente('SIGLA ');
  WriteLn('SPPSRVSetUtente ha tornato: ' + IntToStr(rc));
  // impostazione della data
  rc := SPPSRVSetTodayDate(pChar(FormatDateTime('yyyymmdd', Date)));
  WriteLn('SPPSRVSetTodayDate ha tornato: ' + IntToStr(rc));
  // impostazione dell'euro come valuta di lavoro
  rc := SPPSRVSetEuro(TRUE);
  WriteLn('SPPSrvSetEuro ha tornato: ' + IntToStr(rc));
 
  // calcolo delle scadenze
  WriteLn('Calcolo della scadenza...');
  // int DLLCALL SPPSRVCalcolaScadenze(LPSTR tipopag,BOOL IsValuta,double TRata,
  // LPSTR DataFattura,LPSTR datadecpag,
  // LPSTR ggpart,LPSTR msalto1,LPSTR msalto2,LPSTR ggsalto);
  // parametri
  DataFattura := '20121113';
  datadecpag := '201211300;
  ggpart := '';
  msalto1 := '';
  msalto2 := '';
  ggsalto := '';
  TRata := 1000.0;
  IsValuta := FALSE;
  tipopag := 'RB02';
  rc := SPPSRVCalcolaScadenze(pChar(tipopag), IsValuta, TRata, pChar(DataFattura),pChar(datadecpag),
  pChar(ggpart), pChar(msalto1), pChar(msalto2), pChar(ggsalto));
  WriteLn('SPPSRVCalcolaScadenze ha tornato: ' + IntToStr(rc));
  // lettura delle scadenze
  numscad := rc;
  importo := 0;
  if (numscad > 0) then begin
  for j := 1 to numscad do begin
  rc := SPPSRVReadScadenza(j, @importo, dt1, tipo);
  if (rc = 0) then
  WriteLn(IntToStr(j) + ') Data: ' + Copy(dt1, 7, 2) + '/' + Copy(dt1, 5, 2) +
  '/' + Copy(dt1, 1, 4) + ' Importo: ' + FloatToStr(importo))
  else
  WriteLn(IntToStr(j) + ') SPPSRVReadScadenza ha tornato: ' + IntToStr(rc));
  end;
  end;
 
 FINE:
  // resetta la DLL
  rc := SPPSRVExit();
  WriteLn('SPPSRVExit ha tornato: ' + IntToStr(rc));
 
 END_OF_TEST:
  if (dll > 0 ) then FreeLibrary(dll);
  WriteLn('---------------------------------------------------');
  WriteLn('Fine test ' + MY_LIBRARY_NAME);
 
  WriteLn('... premere <INVIO> per terminare...');
  ReadLn;
 end.
 

Bibliografia

Voci correlate

Come si personalizza SIGLA
SPPSERV.DLL
La libreria SIGPPDLL
La libreria SPPFrame

Estratto da "https://www.deltaphi.it/siglakb/index.php?title=Esempio_SPPSERV/Sviluppo_scadenze/delphi&oldid=3420"