"bpl" load in IntraWeb - delphi

I am setting up a module of "bpl" load in IntraWeb, Delphi2010, and I found the following problem:
I don't get to create an instance the application to not to be this is as an internal form.
.
procedure CargaDoSubModulo;
type
TIWFormClass = class of TIWForm;
var
Integra : IIntegracaoIW;
Formulario : TIWForm;
intClas : Integer;
strForm : String;
begin
strForm := srtPacotes + '_' + Copy ( IntToStr ( Rtn_Alternativa) + 10000 ), 2, 4 );
// Descrição do formulário
strDescricaoTela := Des_Tela;
// Nome da classe do formulário
vrtClasseModulo := 'p_' + strForm + '.dll';
// Nome da rotina interna a ser carregada
strForm := 'iwfrm_' + strForm;
// Nome da classe do formulário
vrtNomeFormulario := 'T' + strForm;
// Verificação se a rotina e compativel com o sistema iwfrm_hrb_0010
intClas := -1;
if WebApplication.FindComponent( strForm ) = nil then
begin
Formulario := TIWFormClass(FindClass( vrtNomeFormulario )).Create(WebApplication);
if not Supports (Formulario, IIntegracaoIW) then
begin
WebApplication.ShowMessage(CargaTexto(msnRotIncompIntgra), smAlert);
Exit;
end;
Integra := Formulario as IIntegracaoIW;
with Integra do
begin
SetServidor( ParServidor1.Servidor ); // 1
SetAreaTrabalho( ParServidor1.AreaTrabalho ); // 2
SetIdUsuario( intUsuario ); // 3
SetNomeUsuario( iwlStUsuario.Caption ); // 11
SetAcesso( intAcesso ); // 4
SetEmpresa( ParServidor1.Empresa ); // 5
SetFilial( ParServidor1.Filial ); // 6
SetIdClasse( intClas ); // 8
SetVersao( strVersaoInterna ); // 10
SetDescricao(Des_Tela ); // 7
SetEnderecoIP( strIdentificacaoPorta ); // 13
SetDataTrabalho( DateToStr(dtDataTrabalho) ); // 14
SetIdentificacaoSistema( iwlIdentificacao.Caption ); // 12
SetModuloCarga(Rtn_Busca ); // 9
end;
end;
TIWAppForm(WebApplication.FindComponent( strForm )).Show;
end;

Your question - or actually the exact problem/error - is a bit unclear to me. Locating a form via FindComponent is a bit uncommon. At least you shouldn't call FindComponent more than nessecary, as it is potentially slow.
If you create a Form with WebApplication being the owner, it will be added to WebApplication.Forms
Web Application.FormCount is the number of forms (UserSession is a form in this context). WebApplication.ActiveForm is the form that is currently shown.

Related

Why does TFormatSettings use incorrect ShortTimeFormat?

After several hours of investigations and researching the problem, I've found that TFormatSettings returns an incorrect ShortTimeFormat.
To show in TDateTimePicker a short time format with support for 24-hours, I need to use: TDateTimePicker.Format :='H:mm', and this is a default setting for my profile in Windows 10 for a short time.
But TFormatSettings.ShortTimeFormat return me a value of 'h:mm'.
To get the correct value, I should use:
GetLocaleStr(LOCALE_USER_DEFAULT, LOCALE_SSHORTTIME, '');
And this returns a 'H:mm' value.
This is the source of TFormatSettings from SysUtils.pas:
TimePrefix := '';
TimePostfix := '';
if StrToIntDef(GetLocaleStr(Locale, LOCALE_ITLZERO, '0'), 0) = 0 then
HourFormat := 'h'
else
HourFormat := 'hh';
if StrToIntDef(GetLocaleStr(Locale, LOCALE_ITIME, '0'), 0) = 0 then
if StrToIntDef(GetLocaleStr(Locale, LOCALE_ITIMEMARKPOSN, '0'), 0) = 0 then
TimePostfix := ' AMPM'
else
TimePrefix := 'AMPM ';
Result.ShortTimeFormat := TimePrefix + HourFormat + ':mm' + TimePostfix;
Result.LongTimeFormat := TimePrefix + HourFormat + ':mm:ss' + TimePostfix;
As we can see, that always use 'h' or 'hh', no way to get 'H' or 'HH'.
My question is: Why?

Max number of fields in FIREDAC select statement in runTime

I migrated my application from BDE to FIREDac.
A routine that I use to update my database does not work:
SELECT
CODIGO , NOME , ENDERECO , ENDERECO1 , COMPLEMENTO , COMPLEMENTO1 ,
PONTOREFERENCIA , BAIRRO , CIDADE , UF , PAIS , CEP , CX_POSTAL ,
FONE , FAX , EMAIL , CONTATO , CGC , INSCRICAO , DATA_FICHA , CI ,
CPF , TIT_ELEITOR , DATA_NASC , SEXO , EST_CIVIL , NATURAL , FILIACAO ,
PAI , MAE , CONJUGE , NASC_CONJ , ALUGUEL , VAL_ALUGUEL , TEMP_RESID ,
EMPRESA , FONE_EMPR , ADMISSAO , CEP_EMPR , CIDA_EMPR , UF_EMPR ,
FUNCAO , TEMP_SERV , REF_COML , REF_BANC , CONS_SPC , OBS , CREDITO ,
ATRASO , SALARIO , ENDEMPRESA , FOTO , NOMEFANTASIA , CREDITOS ,
ENDCOBRANCA , RESTRICAO , BAIRRO_EMPR , INATIVO , CONTATO1 , CONTATO2 ,
CONTATO3 , TAXABOLETO , RESTRICAOANTIGA , NUMERO , IDCIDADE ,
IDPAISES , CUF
FROM
Clientes
It gives me an internal error.
Some light ??!
Note: In Time designer, put the direct command in FdQuery and it works normally!bs: In designer Time, input direct comand in FdQuery and
Note2: BD is in Access !!!
As I tried to explain, I would select the data and inserted No target table! The abiaxo routine works for tables with few fields. but in the case of error above it!
The select was only to demonstrate the table where the error occurs!
The code:
procedure ConverteTabela(Query: TFDQuery; Alias, Tabela, Campo: string; Tipo: Integer; Senha: string);
var
Tabela1: TFDTable;
I: Integer;
STR:String;
begin
// Tipo = 0 -> Todos os registros da tabela antiga
// Tipo = 1 -> Todos os registros da tabela antiga que não estão na tabela de atualização
// Tipo = 2 -> Todos os registros da tabela antiga que possuem Campo <> 0
// Tipo = 3 -> Apaga os registro da tabela de atualização e coloca os da empresa
Tabela1 := TFDTable.Create(Application);
Tabela1.ConnectionName := Query.ConnectionName;
Tabela1.TableName := Tabela;
Str:='';
try
Tabela1.open;
for I := 0 to tabela1.Fields.Count-1 do
begin
if not (i=tabela1.Fields.Count-1) then
begin
Str:= Str + UpperCase(tabela1.Fields[i].FieldName)+ ' , '
end
else
Str:= Str + tabela1.Fields[i].FieldName;
end;
Tabela1.Close;
Tabela1.free;
except
exit;
end;
Mensagem('Convertendo : ' + Tabela + ' ...');
if Tipo = 3 then
begin
Query.SQL.Clear;
Query.SQL.Add('DELETE FROM "'+ Alias + '".'+Tabela);
Query.ExecSQL;
Tipo := 0;
end;
//test Select -
Query.SQL.Clear;
Query.SQL.Text := 'Select ' + str + 'from '+Tabela;
Query.open;
Query.SQL.Clear;
Query.SQL.Text:='INSERT INTO "'+ Alias + '".'+tabela+' ('+str+')'+ ' SELECT '+str+' FROM ' + Tabela;
if (Tipo = 1) then
begin
Query.SQL.Add('WHERE ' + Campo + ' NOT IN');
Query.SQL.Add('(SELECT ' + Campo + ' FROM "'+ Alias + '".'+tabela+')');
end
else if (Tipo = 2) then
begin
Query.SQL.Add('WHERE ' + Campo + ' <> 0');
Query.SQL.Add('AND ' + Campo + ' <> -1');
end;
// Query.Prepare;
try
Query.ExecSQL;
except
showmessage('Erro ao executar comando : ' + Query.Sql.CommaText);
exit;
end;
end;

CIS(Clever Internet Suite) form fieldvalue encode

Delphi XE5 + CIS 7.8 for XE5,when POST use Chinese formfield value like below
clHttpRequest.AddFormField('Status', '待处理');
itAutoStatus := '待处理' ;
mmo1.Lines.Add( ' 汉字为 : <'+ itAutoStatus +'>' ) ; // <待处理>
a2us := AnsiToUtf8(itAutoStatus) ;
mmo1.Lines.Add( ' 汉字AnsiToUtf8为 : <' + a2us +'>' ) ; // <待处理>
gbs := HTTPEncode(itAutoStatus);
mmo1.Lines.Add( ' 汉字HTTPEncode为 : <' + gbs +'>' ) ; // <%B4%FD%B4%A6%C0%ED>
utfs := HTTPEncode(AnsiToUtf8(itAutoStatus));
mmo1.Lines.Add( ' 汉字HTTPEncode(AnsiToUtf8())为 : <' + utfs +'>' ) ; // <%E5%BE%85%E5%A4%84%E7%90%86>
in IE8,right raw stream is : pageNo=1&total=&SortField=&SortType=&PromTitle=&C1=&Status=%E5%BE%85%E5%A4%84%E7%90%86
clHttpRequest.AddFormField('Status', '待处理');
CIS default raw stream is : pageNo=1&total=&SortField=&SortType=&PromTitle=&C1=&Status=%B4%FD%B4%A6%C0%ED
clHttpRequest.AddFormField('Status', HTTPEncode(AnsiToUtf8('待处理')));
Now CIS raw stream is : pageNo=1&total=&SortField=&SortType=&PromTitle=&C1=&Status=%25E5%25BE%2585%25E5%25A4%2584%25E7%2590%2586
clHttpRequest.AddFormField add string '25',so web server will no database query result.
I want to make raw stream like IE8,How to fix this? thanks!!!
solved
clHttpRequest.Header.CharSet := 'UTF-8';

Strange behaviour using StrUtils 'SearchBuf'

I am tidying old code that used to use FastStrings and I've implemented an old routine of mine 'PosAnyCase' which should operate like 'Pos'. (I was hoping that SearchBuf was better than calling UpperCase on both strings).
function PosAnyCase( const AFindStr, AStr : string ) : integer;
// Returns the position of this substring within a string ignoring case
I'm using SearchBuf as follows:
function PosAnyCase( const AFindStr, AStr : string ) : integer;
// Returns the position of this substring within a string ignoring case
var
Start, ResultPos : PChar;
begin
Start := PChar( AStr );
ResultPos := SearchBuf(
Start, ByteLength( AStr ),
0, 0,
AFindStr, [soDown] );
if ResultPos = nil then
Result := 0
else
Result := ResultPos-Start+1;
end;
When I call this routine from my unit tests, the following tests PASS:
Check(
PosAnyCase( '', '123' ) = 0 );
Check(
PosAnyCase( '2', '123' ) = 2 );
Check(
PosAnyCase( 'A', 'ABC' ) = 1 );
Check(
PosAnyCase( 'a', 'ABC' ) = 1 );
Check(
PosAnyCase( 'the', 'hellot there' ) = 8 );
Check(
PosAnyCase( 'THE', 'hellot there' ) = 8 );
But this test FAILS:
Check(
PosAnyCase( 'nice', 'does not have n i c e' ) = 0 );
What am I doing wrong please? The documentation on SearchBuf is very limited....
Thanks
The call to ByteLength is incorrect. Although the documentation explicitly states that the parameter is the length in bytes, that is not the case. You should use Length instead because the function actually expects units of char rather than units of byte.

Where can I find a "ESC/POS" Epson Barcode Test Program?

I am struggling to get an Epson "ESC/POS" printer to print barcodes (Using Delphi) and want to test if the printer is not faulty. Do you know where I can find a program to print a barcode in "ESC/POS"? I suppose as a last resort an OPOS program will also be OK.
Also, a demo Delphi Program that works will also be fine. All the Delphi snippets I have so far is not working.
The printer I am using is an Epson TM-L60II
I Have a full tests program written in Delphi 5 for the TMT88's but the source is abit big for here so here is the barcode bits
Please note that as its snippets from the full object some vars/functions may be missing
To get the barcode chars
{**
* #param a ean13 barcode numeric value
* #return the escpos code for the barcode print
* Description uses escpos code, return code needed to print a ean13 barcode
*}
function TPrintEscPosToPort.getBarcodeEscPosCode(l_ean13:String):String;
var
l_return:String;
begin
l_return := CHR(29) + 'k' + CHR(67) + CHR(12);
l_return := l_return + l_ean13; // Print bar code
l_return := l_return + l_ean13; // Print bar code number under thge barcode
Result := l_return
end;
to print to a printer
{**
* #param Printer Name, Item be printed, Cut the papers after the cut, #no of copies to print
* #return boolen, true if it printed
* Description prints a test page to the tysso printer
*}
function TPrintEscPosToPort.escPosPrint(const l_printer, l_textToPrint :String;l_cutPaper:Boolean=true;l_copies:integer=1): Boolean;
var
l_pPort,l_pName,l_tmp:String;
i,x:integer;
PrinterFile: TextFile;
begin
// set result to false so any thing other then a good print will be false
Result:= FALSE;
try
//Find if the printer exists, else set to defult -1
i := Printer.Printers.IndexOf(l_printer);
if (i > -1) then
begin
Printer.PrinterIndex := i;
l_pName := Printer.Printers[i]; //Get the printer name (incase its the defult and not the one passed)
l_pPort := Self.getPrinterPort(l_pName) ; // get the port name from the reg
end;
// If true add headers and footers to the passed text
if (Self.aPrintHeadersFooters) then
begin
l_tmp := Self.getHeader()
+ l_textToPrint + Self.GetFooter();
end
else
begin
l_tmp := l_textToPrint;
end;
//Send the Document To the printer
try
for x:= 1 to l_copies do //Print multi-copies
Begin
//Assign the file to a tmp file in the printer port
if (length(trim(l_pPort)) > 0) then AssignFile(PrinterFile,l_pPort)
else
begin
//only use if we cant get the port
//(may look bad as ctrl codes are still in place)
AssignPrn(PrinterFile);
l_tmp := Self.stripEscPos(l_tmp);
end;
Rewrite(PrinterFile);
try
//Send the passed Text to the printer
WriteLn(PrinterFile,l_tmp);
if (Self.aPrinterReset) then
WriteLn(PrinterFile,escReset); // Reset the printer alignment
if (l_cutPaper) then
WriteLn(PrinterFile,escFeedAndCut); //Cut the paper if needed
finally
CloseFile(PrinterFile);
Result:= true;
end;
end;
except
end;
except
end;
end;
Update
Here is a lost of control code constants from the code above, hopefully the names are descriptive enough.
const
escNewLine = chr(10); // New line (LF line feed)
escUnerlineOn = chr(27) + chr(45) + chr(1); // Unerline On
escUnerlineOnx2 = chr(27) + chr(45) + chr(2); // Unerline On x 2
escUnerlineOff = chr(27) + chr(45) + chr(0); // Unerline Off
escBoldOn = chr(27) + chr(69) + chr(1); // Bold On
escBoldOff = chr(27) + chr(69) + chr(0); // Bold Off
escNegativeOn = chr(29) + chr(66) + chr(1); // White On Black On'
escNegativeOff = chr(29) + chr(66) + chr(0); // White On Black Off
esc8CpiOn = chr(29) + chr(33) + chr(16); // Font Size x2 On
esc8CpiOff = chr(29) + chr(33) + chr(0); // Font Size x2 Off
esc16Cpi = chr(27) + chr(77) + chr(48); // Font A - Normal Font
esc20Cpi = chr(27) + chr(77) + chr(49); // Font B - Small Font
escReset = chr(27) + chr(64); //chr(27) + chr(77) + chr(48); // Reset Printer
escFeedAndCut = chr(29) + chr(86) + chr(65); // Partial Cut and feed
escAlignLeft = chr(27) + chr(97) + chr(48); // Align Text to the Left
escAlignCenter = chr(27) + chr(97) + chr(49); // Align Text to the Center
escAlignRight = chr(27) + chr(97) + chr(50); // Align Text to the Right
Get the Microsoft POS For .Net 1.11, it's got an SDK that includes a sample application that performs all the basic operations on POS hardware. I'm using it all the time to test that cash drawers work ok for example.
There's also a source code included (in .Net), so you can see how they do it.

Resources