Skip to content

K
KGOrders
Commit 82a18ead by Cam Hayes
Options

Customer Page moved over and working

parent 4fbdce5d
Showing with 790 additions and 9 deletions
kgOrdersClient/View.Customers.dfm 0 → 100644
object FViewCustomers: TFViewCustomers
Width = 640
Height = 480
OnCreate = WebFormCreate
object lblEntries: TWebLabel
Left = 12
Top = 117
Width = 81
Height = 15
Caption = 'Showing 0 of ...'
ElementID = 'lblentries'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object btnAddCustomer: TWebButton
Left = 12
Top = 81
Width = 96
Height = 25
Caption = 'Add Customer'
ChildOrder = 5
ElementID = 'btnaddcustomer'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
TabOrder = 6
TabStop = False
WidthPercent = 100.000000000000000000
end
object wdbtcCustomers: TWebDBTableControl
Left = 9
Top = 138
Width = 631
Height = 200
ElementClassName = 'table'
ElementId = 'tblPhoneGrid'
BorderColor = clSilver
ChildOrder = 11
ElementFont = efCSS
ElementHeaderClassName = 'thead-light sticky-top bg-light'
ElementPosition = epRelative
ElementTableClassName = 'table table-striped table-hover table-bordered text-sm'
Footer.ButtonActiveElementClassName = 'btn btn-primary'
Footer.ButtonElementClassName = 'btn btn-light'
Footer.DropDownElementClassName = 'form-control'
Footer.InputElementClassName = 'form-control'
Footer.LinkActiveElementClassName = 'link-primary'
Footer.LinkElementClassName = 'link-secondary'
Footer.ListElementClassName = 'pagination'
Footer.ListItemElementClassName = 'page-item'
Footer.ListLinkElementClassName = 'page-link'
Header.ButtonActiveElementClassName = 'btn btn-primary'
Header.ButtonElementClassName = 'btn btn-light'
Header.DropDownElementClassName = 'form-control'
Header.InputElementClassName = 'form-control'
Header.LinkActiveElementClassName = 'link-primary'
Header.LinkElementClassName = 'link-secondary'
Header.ListElementClassName = 'pagination'
Header.ListItemElementClassName = 'page-item'
Header.ListLinkElementClassName = 'page-link'
WordWrap = True
Columns = <
item
DataField = 'START_DATE'
Title = 'Start Date'
end
item
DataField = 'NAME'
Title = 'Name'
end>
DataSource = wdsCustomers
end
object wcbPageSize: TWebComboBox
Left = 22
Top = 52
Width = 145
Height = 23
ElementClassName = 'custom-select'
ElementID = 'wcbpagesize'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = '500'
WidthPercent = 100.000000000000000000
ItemIndex = -1
Items.Strings = (
'100'
'250'
'500'
'1000')
end
object pnlMessage: TWebPanel
Left = 12
Top = 16
Width = 121
Height = 33
ElementID = 'view.login.message'
ChildOrder = 17
TabOrder = 3
object lblMessage: TWebLabel
Left = 16
Top = 11
Width = 46
Height = 15
Caption = 'Message'
ElementID = 'view.login.message.label'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object btnCloseNotification: TWebButton
Left = 96
Top = 3
Width = 22
Height = 25
ChildOrder = 1
ElementID = 'view.login.message.button'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
end
object XDataWebClient1: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 28
Top = 410
end
object wdsCustomers: TWebDataSource
DataSet = xdwdsCustomers
Left = 224
Top = 414
end
object xdwdsCustomers: TXDataWebDataSet
Connection = DMConnection.ApiConnection
Left = 130
Top = 410
object xdwdsCustomersNAME: TStringField
FieldName = 'NAME'
end
object xdwdsCustomersSTART_DATE: TStringField
FieldName = 'START_DATE'
end
end
end
kgOrdersClient/View.Customers.html 0 → 100644
<div class="container h-100 d-flex flex-column mt-0" style="max-width: 100%; padding-bottom: 0;">
<!-- Alert Section -->
<div class="row">
<div class=col-sm>
<div id="view.login.message" class="alert alert-danger">
<button id="view.login.message.button" type="button" class="btn-close" aria-label="Close"></button>
<span id="view.login.message.label"></span>
</div>
</div>
</div>
<!-- Actions Row -->
<div class="row mt-3 justify-content-center">
<div class="col-auto d-flex align-items-center">
<label class="mt-3" style="font-weight: 700;font-size: 1.10rem;">Show <select class="custom-select" id="wcbpagesize" style="font-size: 1.00rem;"></select> entries</label>
</div>
<div class="col-auto">
<button id="btnaddcustomer" class="btn btn-secondary mt-3">Add Customer</button>
</div>
</div>
<!-- Entries Label Section d-flex justify-content-between w-100 mt-2-->
<div class="row">
<div class="col-auto">
<label id="lblentries" style="font-size: 1.10rem;"></label>
</div>
</div>
<!-- Table Section -->
<div id="order_table_section" class="overflow-auto mt-2"
style="max-height: calc(100vh - 250px); padding-bottom: 0; width: 100%;">
<table id="tblPhoneGrid" class="table table-striped table-bordered" style="width: 100%;">
<thead class="sticky-top thead-light">
<tr style="font-size: 0.875rem;">
<!-- Table headers are dynamically generated -->
</tr>
</thead>
<tbody id="orderTableBody" class="align-middle">
<!-- Table rows are dynamically generated -->
</tbody>
</table>
</div>
<!-- Pagination Section -->
<div class="d-flex justify-content-center w-100 mt-4">
<nav aria-label="Page navigation">
<ul id="pagination" class="pagination">
<!-- Pagination items added dynamically -->
</ul>
</nav>
</div>
</div>
kgOrdersClient/View.Main.pas
......@@ -78,7 +78,8 @@ uses
View.Orders,
View.OrderEntryCorrugated,
View.OrderEntryCuttingDie,
View.OrderEntryWeb;
View.OrderEntryWeb,
View.Customers;
{$R *.dfm}
......@@ -110,9 +111,9 @@ procedure TFViewMain.lblCustomersClick(Sender: TObject);
begin
if ( not ( change ) ) then
begin
//ShowForm(TFViewCustomers);
lblAppTitle.Caption := 'Koehler-Gibson Customers';
setActive('Customers');
ShowForm(TFViewCustomers);
lblAppTitle.Caption := 'Koehler-Gibson Customers';
setActive('Customers');
end
else
ShowMessage('Please Save or Cancel your changes');
......
kgOrdersClient/webKGOrders.dpr
......@@ -23,7 +23,8 @@ uses
View.Search in 'View.Search.pas' {FSearch: TWebForm} {*.html},
View.SetStatus in 'View.SetStatus.pas' {FSetStatus: TWebForm} {*.html},
View.OrderEntryCuttingDie in 'View.OrderEntryCuttingDie.pas' {FOrderEntryCuttingDie: TWebForm} {*.html},
View.OrderEntryWeb in 'View.OrderEntryWeb.pas' {FOrderEntryWeb: TWebForm} {*.html};
View.OrderEntryWeb in 'View.OrderEntryWeb.pas' {FOrderEntryWeb: TWebForm} {*.html},
View.Customers in 'View.Customers.pas' {FViewCustomers: TWebForm} {*.html};
{$R *.res}
......
kgOrdersClient/webKGOrders.dproj
......@@ -186,6 +186,11 @@
<Form>FOrderEntryWeb</Form>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="View.Customers.pas">
<Form>FViewCustomers</Form>
<FormType>dfm</FormType>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<None Include="index.html"/>
<None Include="css\app.css"/>
<None Include="config\config.json"/>
......@@ -219,9 +224,33 @@
<Deployment Version="5">
<DeployFile LocalName="Win32\Debug\webCharms.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="Win32\Debug\webKGOrders.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="Win32\Debug\webKGOrders.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>webKGOrders.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="config\config.json" Configuration="Debug" Class="ProjectFile"/>
<DeployFile LocalName="config\config.json" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="css\app.css" Configuration="Debug" Class="ProjectFile"/>
<DeployFile LocalName="css\app.css" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="index.html" Configuration="Debug" Class="ProjectFile"/>
<DeployFile LocalName="index.html" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="template\bootstrap\bootstrap.min.css" Configuration="Debug" Class="ProjectFile"/>
<DeployFile LocalName="template\bootstrap\bootstrap.min.js" Configuration="Debug" Class="ProjectFile"/>
<DeployFile LocalName="template\bootstrap\dataTables.bootstrap.css" Configuration="Debug" Class="ProjectFile"/>
......
kgOrdersServer/Source/Lookup.Service.pas
......@@ -117,6 +117,7 @@ type
ID: integer;
SHORT_NAME: string;
staff_fields_invoice_to: string;
START_DATE: String;
ADDRESS_LIST: TList<TAddressItem>;
ITEMS: TItemList;
end;
......
kgOrdersServer/Source/Lookup.ServiceImpl.pas
......@@ -94,7 +94,7 @@ var
SQL: string;
customer: TCustomerItem;
begin
SQL := 'select NAME, CUSTOMER_ID, SHORT_NAME, BILL_ADDRESS, BILL_CITY, BILL_STATE, BILL_ZIP from customers';
SQL := 'select NAME, CUSTOMER_ID, SHORT_NAME, BILL_ADDRESS, BILL_CITY, BILL_STATE, BILL_ZIP, START_DATE from customers';
doQuery(ordersDB.UniQuery1, SQL);
result := TCustomerList.Create;
......@@ -112,6 +112,7 @@ begin
customer.staff_fields_invoice_to := ordersDB.UniQuery1.FieldByName('BILL_ADDRESS').AsString +
', ' + ordersDB.UniQuery1.FieldByName('BILL_CITY').AsString +
' ' + ordersDB.UniQuery1.FieldByName('BILL_ZIP').AsString;
customer.START_DATE := ordersDB.UniQuery1.FieldByName('START_DATE').AsString;
result.data.Add(customer);
result.count := result.count + 1;
ordersDB.UniQuery1.Next;
......
kgOrdersServer/Source/Main.dfm
......@@ -67,6 +67,15 @@ object FMain: TFMain
TabOrder = 4
OnClick = btnAuthSwaggerUIClick
end
object btnQB: TButton
Left = 444
Top = 8
Width = 75
Height = 25
Caption = 'QB'
TabOrder = 5
OnClick = btnQBClick
end
object initTimer: TTimer
OnTimer = initTimerTimer
Left = 58
......
kgOrdersServer/Source/Main.pas
......@@ -21,6 +21,7 @@ type
initTimer: TTimer;
btnAuthSwaggerUI: TButton;
ExeInfo1: TExeInfo;
btnQB: TButton;
procedure btnApiSwaggerUIClick(Sender: TObject);
procedure btnDataClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
......@@ -28,6 +29,7 @@ type
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure initTimerTimer(Sender: TObject);
procedure btnAuthSwaggerUIClick(Sender: TObject);
procedure btnQBClick(Sender: TObject);
strict private
procedure StartServers;
......@@ -44,7 +46,7 @@ uses
Common.Config,
Sparkle.Utils,
Api.Database,
Data;
Data, qbAPI;
{$R *.dfm}
......@@ -76,6 +78,13 @@ begin
Close;
end;
procedure TFMain.btnQBClick(Sender: TObject);
begin
FQB := TfQB.Create( self );
FQB.ShowModal;
FQB.Free;
end;
procedure TFMain.btnAuthSwaggerUIClick(Sender: TObject);
begin
ShellExecute(Handle, 'open', PChar(TSparkleUtils.CombineUrlFast(AuthServerModule.XDataServer.BaseUrl, 'swaggerui')), nil, nil, SW_SHOWNORMAL);
......
kgOrdersServer/Source/qbAPI.dfm 0 → 100644
object fQB: TfQB
Left = 0
Top = 0
Caption = 'fQB'
ClientHeight = 711
ClientWidth = 962
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
OnCreate = FormCreate
TextHeight = 15
object Memo1: TMemo
Left = 0
Top = 76
Width = 962
Height = 260
Align = alBottom
Lines.Strings = (
'Memo1')
ScrollBars = ssVertical
TabOrder = 0
ExplicitTop = 58
end
object Button1: TButton
Left = 42
Top = 18
Width = 87
Height = 25
Caption = 'Company Info'
TabOrder = 1
OnClick = Button1Click
end
object Memo2: TMemo
Left = 0
Top = 336
Width = 962
Height = 196
Align = alBottom
Lines.Strings = (
'Memo2')
ScrollBars = ssVertical
TabOrder = 2
end
object Button2: TButton
Left = 148
Top = 18
Width = 87
Height = 25
Caption = 'Get Customers'
TabOrder = 3
OnClick = Button2Click
end
object asgData: TAdvStringGrid
Left = 0
Top = 532
Width = 962
Height = 179
Align = alBottom
DrawingStyle = gdsClassic
FixedColor = clWhite
TabOrder = 4
GridLineColor = 13948116
GridFixedLineColor = 11250603
ActiveCellFont.Charset = DEFAULT_CHARSET
ActiveCellFont.Color = 4474440
ActiveCellFont.Height = -12
ActiveCellFont.Name = 'Segoe UI'
ActiveCellFont.Style = [fsBold]
ActiveCellColor = 11565130
ActiveCellColorTo = 11565130
BorderColor = 11250603
ControlLook.FixedGradientFrom = clWhite
ControlLook.FixedGradientTo = clWhite
ControlLook.FixedGradientHoverTo = clWhite
ControlLook.FixedGradientHoverMirrorFrom = clWhite
ControlLook.FixedGradientHoverMirrorTo = clWhite
ControlLook.FixedGradientHoverBorder = 11645361
ControlLook.FixedGradientDownFrom = clWhite
ControlLook.FixedGradientDownTo = clWhite
ControlLook.FixedGradientDownMirrorFrom = clWhite
ControlLook.FixedGradientDownMirrorTo = clWhite
ControlLook.FixedGradientDownBorder = 11250603
ControlLook.DropDownHeader.Font.Charset = DEFAULT_CHARSET
ControlLook.DropDownHeader.Font.Color = clWindowText
ControlLook.DropDownHeader.Font.Height = -11
ControlLook.DropDownHeader.Font.Name = 'Segoe UI'
ControlLook.DropDownHeader.Font.Style = []
ControlLook.DropDownHeader.Visible = True
ControlLook.DropDownHeader.Buttons = <>
ControlLook.DropDownFooter.Font.Charset = DEFAULT_CHARSET
ControlLook.DropDownFooter.Font.Color = clWindowText
ControlLook.DropDownFooter.Font.Height = -11
ControlLook.DropDownFooter.Font.Name = 'Segoe UI'
ControlLook.DropDownFooter.Font.Style = []
ControlLook.DropDownFooter.Visible = True
ControlLook.DropDownFooter.Buttons = <>
ControlLook.ToggleSwitch.BackgroundBorderWidth = 1.000000000000000000
ControlLook.ToggleSwitch.ButtonBorderWidth = 1.000000000000000000
ControlLook.ToggleSwitch.CaptionFont.Charset = DEFAULT_CHARSET
ControlLook.ToggleSwitch.CaptionFont.Color = clWindowText
ControlLook.ToggleSwitch.CaptionFont.Height = -12
ControlLook.ToggleSwitch.CaptionFont.Name = 'Segoe UI'
ControlLook.ToggleSwitch.CaptionFont.Style = []
ControlLook.ToggleSwitch.Shadow = False
Filter = <>
FilterDropDown.Font.Charset = DEFAULT_CHARSET
FilterDropDown.Font.Color = clWindowText
FilterDropDown.Font.Height = -12
FilterDropDown.Font.Name = 'Segoe UI'
FilterDropDown.Font.Style = []
FilterDropDown.TextChecked = 'Checked'
FilterDropDown.TextUnChecked = 'Unchecked'
FilterDropDownClear = '(All)'
FilterEdit.TypeNames.Strings = (
'Starts with'
'Ends with'
'Contains'
'Not contains'
'Equal'
'Not equal'
'Larger than'
'Smaller than'
'Clear')
FixedRowHeight = 22
FixedFont.Charset = DEFAULT_CHARSET
FixedFont.Color = 3881787
FixedFont.Height = -11
FixedFont.Name = 'Segoe UI'
FixedFont.Style = [fsBold]
FloatFormat = '%.2f'
HoverButtons.Buttons = <>
HTMLSettings.ImageFolder = 'images'
HTMLSettings.ImageBaseName = 'img'
Look = glCustom
PrintSettings.DateFormat = 'dd/mm/yyyy'
PrintSettings.Font.Charset = DEFAULT_CHARSET
PrintSettings.Font.Color = clWindowText
PrintSettings.Font.Height = -12
PrintSettings.Font.Name = 'Segoe UI'
PrintSettings.Font.Style = []
PrintSettings.FixedFont.Charset = DEFAULT_CHARSET
PrintSettings.FixedFont.Color = clWindowText
PrintSettings.FixedFont.Height = -12
PrintSettings.FixedFont.Name = 'Segoe UI'
PrintSettings.FixedFont.Style = []
PrintSettings.HeaderFont.Charset = DEFAULT_CHARSET
PrintSettings.HeaderFont.Color = clWindowText
PrintSettings.HeaderFont.Height = -12
PrintSettings.HeaderFont.Name = 'Segoe UI'
PrintSettings.HeaderFont.Style = []
PrintSettings.FooterFont.Charset = DEFAULT_CHARSET
PrintSettings.FooterFont.Color = clWindowText
PrintSettings.FooterFont.Height = -12
PrintSettings.FooterFont.Name = 'Segoe UI'
PrintSettings.FooterFont.Style = []
PrintSettings.PageNumSep = '/'
SearchFooter.ColorTo = clNone
SearchFooter.FindNextCaption = 'Find &next'
SearchFooter.FindPrevCaption = 'Find &previous'
SearchFooter.Font.Charset = DEFAULT_CHARSET
SearchFooter.Font.Color = clWindowText
SearchFooter.Font.Height = -12
SearchFooter.Font.Name = 'Segoe UI'
SearchFooter.Font.Style = []
SearchFooter.HighLightCaption = 'Highlight'
SearchFooter.HintClose = 'Close'
SearchFooter.HintFindNext = 'Find next occurrence'
SearchFooter.HintFindPrev = 'Find previous occurrence'
SearchFooter.HintHighlight = 'Highlight occurrences'
SearchFooter.MatchCaseCaption = 'Match case'
SearchFooter.ResultFormat = '(%d of %d)'
SelectionColor = 13744549
SortSettings.HeaderColor = clWhite
SortSettings.HeaderColorTo = clWhite
SortSettings.HeaderMirrorColor = clWhite
SortSettings.HeaderMirrorColorTo = clWhite
Version = '9.1.4.1'
end
end
kgOrdersServer/Source/qbAPI.pas 0 → 100644
unit qbAPI;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, AdvUtil, Data.DB, Vcl.Grids, AdvObj,
BaseGrid, AdvGrid, DBAdvGrid, MemDS, DBAccess, Uni, Vcl.StdCtrls, Vcl.Mask,
vcl.wwdbedit, vcl.wwdotdot, vcl.wwdbcomb, REST.Client, REST.Types, System.JSON,
System.Generics.Collections, AdvEdit, vcl.wwdblook, vcl.wwdbdatetimepicker,
System.Hash, Api.Database, Vcl.ExtCtrls, WEBLib.Forms, WEBLib.Controls, WEBLib.StdCtrls,
WEBLib.ExtCtrls, WEBLib.REST, WEBLib.WebTools,System.Net.HttpClient,
System.Net.URLClient, System.Net.HttpClientComponent, System.netencoding,
IdHTTP, IdSSLOpenSSL, IdSSLOpenSSLHeaders, System.DateUtils, System.IniFiles;
type
TfQB = class(TForm)
Memo1: TMemo;
Button1: TButton;
Memo2: TMemo;
Button2: TButton;
asgData: TAdvStringGrid;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
httpReqTokenRefresh: TWebHttpRequest;
var
AccessToken,RefreshToken,CompanyID,Client,Secret: string;
LastRefresh: TDateTime;
public
{ Public declarations }
procedure getCompanyInfo();
procedure LoadJsonArray(jaData: TJSONArray);
function RefreshAccessToken(): string;
procedure ConfigureSSL(IOHandler: TIdSSLIOHandlerSocketOpenSSL);
procedure SaveTokens(AccessToken, RefreshToken: string);
procedure getCustomers();
end;
var
fQB: TfQB;
implementation
uses
Common.Logging;
{$R *.dfm}
procedure TfQB.Button1Click(Sender: TObject);
begin
getCompanyInfo();
end;
procedure TfQB.SaveTokens(AccessToken, RefreshToken: string);
var
f: TStringList;
iniStr, line: string;
iniFile: TIniFile;
begin
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'kgOrdersServer.ini' );
try
iniFile.WriteString('Quickbooks', 'RefreshToken', RefreshToken);
LastRefresh := Now;
Logger.Log(1, 'Tokens Successfully Saved');
finally
IniFile.Free;
end;
f := TStringList.Create;
// Save to file (overwrites existing file)
f.SaveToFile('QB.txt');
f.Free;
end;
procedure TfQB.Button2Click(Sender: TObject);
begin
GetCustomers();
end;
procedure TfQB.getCustomers();
var
restClient: TRESTClient;
restRequest: TRESTRequest;
restResponse: TRESTResponse;
param: TRESTRequestParameter;
res: string;
jsValue: TJSONValue;
Customer: TJSONValue;
jsObj: TJSONObject;
CustomerList: TJSONArray;
pair: TJSONPair;
begin
restClient := TRESTClient.Create(nil);
restClient.BaseURL := 'https://sandbox-quickbooks.api.intuit.com';
restRequest := TRESTRequest.Create(nil);
restRequest.Client := restClient;
restResponse := TRESTResponse.Create(nil);
restRequest.Response := restResponse;
if MinutesBetween(Now, LastRefresh) > 58 then
begin
RefreshAccessToken();
end;
restRequest.Method := rmGET;
res := '/v3/company/' + companyID + '/query?query=select * from Customer&minorversion=75';
restRequest.Resource := res;
param := restRequest.Params.AddItem;
param.Name := 'Authorization';
param.Kind := pkHTTPHEADER;
param.Options := param.Options + [TRESTRequestParameterOption.poDoNotEncode];
param.Value := 'Bearer ' + AccessToken;
restRequest.Execute;
memo1.Lines.Add(restresponse.Content);
jsValue := restResponse.JSONValue;
jsObj := TJSONObject(jsValue);
Memo2.Lines.Add( jsObj.Format(2) );
//CustomerList := TJSONArray(restResponse.JSONValue);
CustomerList := TJSONArray( TJSONObject( jsObj.GetValue('QueryResponse') ).GetValue('Customer')) ;
LoadJSONArray( CustomerList );
{for Customer in CustomerList do
begin
for pair in TJSONObject(Customer).pair do
begin
end;
end; }
//jsObj := TJSONObject.ParseJSONValue(restresponse.Content) as TJSONObject;
//companyInfo := TJSONObject(jsObj.GetValue('CompanyInfo'));
restClient.Free;
restRequest.Free;
restResponse.Free;
end;
procedure TfQB.ConfigureSSL(IOHandler: TIdSSLIOHandlerSocketOpenSSL);
begin
// For Indy 10.6.2+ (Delphi 10.2 Tokyo+)
IOHandler.SSLOptions.Method := sslvTLSv1_2;
// Set SSL versions - maximum compatibility
IOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2];
// For very old Indy versions (fallback)
if not (sslvTLSv1_2 in IOHandler.SSLOptions.SSLVersions) then
begin
IOHandler.SSLOptions.Method := sslvSSLv23;
IOHandler.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
end;
IOHandler.SSLOptions.Mode := sslmClient;
end;
procedure TfQB.FormCreate(Sender: TObject);
var
iniFile: TIniFile;
begin
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'kgOrdersServer.ini' );
Client := iniFile.ReadString('Quickbooks', 'ClientID', '');
Secret := iniFile.ReadString('Quickbooks', 'ClientSecret', '');
CompanyID := iniFile.ReadString('Quickbooks', 'CompanyID', '');
RefreshToken := iniFile.ReadString('Quickbooks', 'RefreshToken', '');
end;
function TfQB.RefreshAccessToken: string;
// Refresh Token changes so make sure to save refresh token.
var
IdHTTP: TIdHTTP;
SSLIO: TIdSSLIOHandlerSocketOpenSSL;
RequestStream: TStringStream;
EncodedAuth, EncodedAuth2, PostData, response: string;
f: TStringList;
fi: string;
JSObj: TJSONObject;
iniFile: TIniFile;
Encoder: TBase64Encoding;
begin
// 1. Encode credentials (same as working Postman request)
// TNetEncoding.Base64.Encode adds a new line every 72 chars, this stops that
Encoder := TBase64Encoding.Create(0);
if( (Client = '') or (Secret = '') ) then
begin
Logger.Log(1, 'Missing Client ID or Client Secret in INI File');
Exit();
end;
EncodedAuth := Encoder.Encode(Client + ':' + Secret);
Memo1.Lines.Add(EncodedAuth);
if RefreshToken = '' then
begin
Logger.Log(3, 'Missing Refresh Token, Please Manually Get a New One and Store in INI File');
Exit();
end;
// 2. Prepare POST data (EXACTLY as in Postman)
PostData := 'grant_type=refresh_token&refresh_token=' + RefreshToken;
// 3. Configure HTTP client
IdHTTP := TIdHTTP.Create(nil);
SSLIO := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
try
// Force TLS 1.2
SSLIO.SSLOptions.Method := sslvTLSv1_2;
SSLIO.SSLOptions.SSLVersions := [sslvTLSv1_2];
IdHTTP.IOHandler := SSLIO;
// Set headers (EXACT match with Postman)
IdHTTP.Request.ContentType := 'application/x-www-form-urlencoded';
IdHTTP.Request.Accept := 'application/json';
IdHTTP.Request.CustomHeaders.AddValue('Authorization', 'Basic ' + EncodedAuth);
// 4. Create and send request
RequestStream := TStringStream.Create(PostData, TEncoding.UTF8);
try
// Execute POST
try
response := IdHTTP.Post('https://oauth.platform.intuit.com/oauth2/v1/tokens/bearer', RequestStream);
JSObj := TJSONObject.ParseJSONValue(response) as TJSONObject;
RefreshToken := JSObj.GetValue('refresh_token').ToString.Trim(['"']);
AccessToken := JSObj.GetValue('access_token').ToString.Trim(['"']);
SaveTokens(AccessToken, RefreshToken);
Result := AccessToken;
Logger.Log(1, 'qbAPI - Tokens Successfully Saved');
Memo1.Lines.Add('Tokens Successfully Saved');
except
on E: EIdHTTPProtocolException do
Memo2.Lines.Add('Error: ' + E.Message + #13#10 + 'Response: ' + E.ErrorMessage);
end;
finally
RequestStream.Free;
end;
finally
SSLIO.Free;
IdHTTP.Free;
end;
end;
procedure TfQB.getCompanyInfo();
var
restClient: TRESTClient;
restRequest: TRESTRequest;
restResponse: TRESTResponse;
param: TRESTRequestParameter;
res: string;
jsValue: TJSONValue;
jsObj, companyInfo: TJSONObject;
begin
restClient := TRESTClient.Create(nil);
restClient.BaseURL := 'https://sandbox-quickbooks.api.intuit.com';
restRequest := TRESTRequest.Create(nil);
restRequest.Client := restClient;
restResponse := TRESTResponse.Create(nil);
restRequest.Response := restResponse;
if MinutesBetween(Now, LastRefresh) > 58 then
begin
RefreshAccessToken();
end;
restRequest.Method := rmGET;
res := '/v3/company/' + companyID + '/companyinfo/' + companyID;
restRequest.Resource := res;
param := restRequest.Params.AddItem;
param.Name := 'Authorization';
param.Kind := pkHTTPHEADER;
param.Options := param.Options + [TRESTRequestParameterOption.poDoNotEncode];
param.Value := 'Bearer ' + AccessToken;
restRequest.Execute;
memo1.Lines.Add(restresponse.Content) ;
//jsValue := restResponse.JSONValue;
//jsObj := TJSONObject.ParseJSONValue(restresponse.Content) as TJSONObject;
//companyInfo := TJSONObject(jsObj.GetValue('CompanyInfo'));
restClient.Free;
restRequest.Free;
restResponse.Free;
end;
procedure TfQB.LoadJsonArray(jaData: TJSONArray);
var
jso: TJSONObject;
i, j: integer;
row: integer;
begin
Memo1.Lines.Add( '---------------------------------------------------------------' );
Memo1.Lines.Add( 'LoadJsonArray into asgData' );
asgData.ClearAll;
asgData.RowCount := 1;
asgData.StartUpdate;
jso := TJSONObject(jaData.Items[0]);
asgData.ColCount := jso.Count;
for i := 0 to jso.Count - 1 do
asgData.Cells[i+1, 0] := jso.Pairs[i].JsonString.Value;
for i := 0 to jaData.Count - 1 do
begin
jso := TJSONObject(jaData.Items[i]);
asgData.RowCount := asgData.RowCount + 1;
row := asgData.RowCount - 1;
for j := 0 to jso.Count - 1 do
asgData.Cells[j+1, row] := jso.Pairs[j].JsonValue.Value;
end;
asgData.EndUpdate;
asgData.AutoSizeColumns(true);
end;
end.
kgOrdersServer/kgOrdersServer.dpr
......@@ -25,7 +25,8 @@ uses
rOrderList in 'Source\rOrderList.pas' {rptOrderList: TDataModule},
rOrderCorrugated in 'Source\rOrderCorrugated.pas' {rptOrderCorrugated: TDataModule},
rOrderWeb in 'Source\rOrderWeb.pas' {rptOrderWeb: TDataModule},
rOrderCutting in 'Source\rOrderCutting.pas' {rptOrderCutting: TDataModule};
rOrderCutting in 'Source\rOrderCutting.pas' {rptOrderCutting: TDataModule},
qbAPI in 'Source\qbAPI.pas' {fQB};
type
TMemoLogAppender = class( TInterfacedObject, ILogAppender )
......
kgOrdersServer/kgOrdersServer.dproj
......@@ -197,6 +197,10 @@
<FormType>dfm</FormType>
<DesignClass>TDataModule</DesignClass>
</DCCReference>
<DCCReference Include="Source\qbAPI.pas">
<Form>fQB</Form>
<FormType>dfm</FormType>
</DCCReference>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
......
kgOrdersServer/kgOrdersServer.ini
......@@ -2,7 +2,7 @@
MemoLogLevel=3
FileLogLevel=5
webClientVersion=0.9.2
LogFileNum=438
LogFileNum=443
[Database]
Server=192.168.159.131
......@@ -13,3 +13,9 @@ Username=root
Password=emsys01
--Password=emsys!012
[Quickbooks]
CompanyID=9341454272655710
ClientID=ABgO14uvjh8XqLud7spQ8lkb98AUpcdA7HbyMJfCAtl65sQ5yy
ClientSecret=bQ06TRemHeAGFzVHRaTUvUoBU9jpU9itK6MOMgqN
RefreshToken=RT1-219-H0-175466891417di6x52592vlv2cmjhu
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment