I've been trying to hide column from a DB cross-tab in FastReport when the column header Value is 14001 ; but is not work down syntax !!!
My Report
Here's the code:
procedure DBCross2OnCalcWidth(ColumnIndex: Integer; ColumnValues: Variant;var Width: Extended);
begin
if (VarToStr(ColumnValues[0]) = '14001') then
Width := 0;
end;
Try add procedure trigged on print and collection HeaderValues[0]
procedure DBCross2OnPrintColumnHeader(Memo: TfrxMemoView; HeaderIndexes, HeaderValues, Value: Variant);
begin
if (VarToStr(HeaderValues[0]) = '14001') then
begin
Memo.Width := 0;
Memo.Height := 0;
Memo.Printable := false;
Memo.Visible := false;
end;
end;
Related
I have defined the following trigger:
CREATE OR REPLACE TRIGGER C_INS_TASK_INSERT
BEFORE INSERT
ON C_INS_TASK
FOR EACH ROW
DECLARE v_yearPaoIdOld VARCHAR2(255);
BEGIN
SELECT BSNUM into v_yearPaoIdOld FROM T_INS_BUSINESSINFO bs
WHERE bs.pbsnum = :new.CBSNUM AND bs.permid = :new.PERMID AND ROWNUM =1;
IF(v_yearPaoIdOld IS NOT NULL) THEN
:NEW.BSNUM := v_yearPaoIdOld;
:NEW.isstart := '1';
:NEW.isfinish := '6';
:NEW.starttime := systimestamp;
END IF;
END;
```
when I execute this code ,I get that error .And then remove the trigger, the next picture is good,so I guess error in IF(v_yearPaoIdOld IS NOT NULL) THEN,but I don't know how to do it.
CREATE OR REPLACE FUNCTION array_replace(INT[]) RETURNS float[] AS $$
DECLARE
arrFloats ALIAS FOR $1;
J int=0;
x int[]=ARRAY[2,4];
-- xx float[]=ARRAY[2.22,4.33];
b float=2.22;
c float=3.33;
retVal float[];
BEGIN
FOR I IN array_lower(arrFloats, 1)..array_upper(arrFloats, 1) LOOP
FOR K IN array_lower(x, 1)..array_upper(x, 1) LOOP
IF (arrFloats[I]= x[K])THEN
retVal[j] :=b;
j:=j+1;
retVal[j] :=c;
j:=j+1;
ELSE
retVal[j] := arrFloats[I];
j:=j+1;
END IF;
END LOOP;
END LOOP;
RETURN retVal;
END;
$$ LANGUAGE plpgsql STABLE RETURNS NULL ON NULL INPUT;
When I run this query
SELECT array_replace(array[1,20,2,5]);
it give me output like this
"[0:8]={1,1,20,20,2.22,3.33,2,5,5}"
Now I do not know why it is coming this duplicate values. I mean it is straight away a nested loop ...
I need a output like this one
"[0:8]={1,20,2.22,3.33,5}"
You have a double loop with the x array having two elements. On every iteration you push elements onto the result array, hence you get twice as many values.
If I understand you logic correctly, you want to scan the input array for values of another array in that same order. If the same, then replace these values with another array, leaving other values intact. There are no built-in functions to help you here, so you have to do this from scratch:
CREATE FUNCTION array_replace(arrFloats float[]) RETURNS float[] AS $$
DECLARE
searchArr float[] := ARRAY[1.,20.];
replaceArr float[] := ARRAY[1.11,1.,111.,20.2,20.222];
retVal float[];
i int;
ndx int;
len int;
upp int;
low int
BEGIN
low := array_lower(searchArr, 1)
upp := array_upper(searchArr, 1);
len := upp - low + 1;
i := array_lower(arrFloats, 1);
WHILE i <= array_upper(arrFloats, 1) LOOP -- Use WHILE LOOP so can update i
ndx := i; -- index into arrFloats for inner loop
FOR j IN low .. upp LOOP
IF arrFloats[ndx] != searchArr[j] THEN
-- No match so put current element of arrFloats in the result and update i
retVal := retVal || arrFloats[i];
i := i + 1;
EXIT; -- No need to look further, break out of inner loop
END IF;
ndx := ndx + 1;
IF j = upp THEN
-- We have a match so append the replaceArr to retVal and
-- increase i by length of search_array
retVal := retVal || replaceArr;
i := i + len;
END IF;
END LOOP;
END LOOP;
RETURN retVal;
END;
$$ LANGUAGE plpgsql STABLE STRICT;
This function would become much more flexible if you made searchArr and replaceArr into parameters as well.
Test
patrick#puny:~$ psql -d test
psql (9.5.0, server 9.4.5)
Type "help" for help.
test=# select array_replace(array[1,20,2,5]);
array_replace
------------------------------
{1.11,1,111,20.2,20.222,2,5}
(1 row)
test=# select array_replace(array[1,20,2,5,1,20.1,1,20]);
array_replace
------------------------------------------------------------
{1.11,1,111,20.2,20.222,2,5,1,20.1,1.11,1,111,20.2,20.222}
(1 row)
As you can see it works for multiple occurrences of the search array.
On the server side, text is entered into a memobox. This text is then sent to the Server side using this code:
var
ftmpstr :String;
buf :array[0..255] of char;
msize, nyites :dword;
i :Integer;
..
Command := Socket.ReceiveText;
if split(Command,'|', 0) = 'IBATCH' then
begin
ftmpstr := IBat.Memo1.Text;
nyites := 1;
msize := length(ftmpstr);
Server.Socket.Connections[ListView1.Selected.Index].SendText(IntToStr(msize));
while msize>255 do
begin
for i := 0 to 255 do
buf[i] := ftmpstr[nyites+i];
Server.Socket.Connections[Form1.ListView1.Selected.Index].SendBuf(buf,256);
dec(msize,256);
inc(nyites,256);
end;
if msize>0 then
begin
for i := 0 to msize-1 do
buf[i] := ftmpstr[nyites+i];
Server.Socket.Connections[Form1.ListView1.Selected.Index].SendBuf(buf,msize);
end;
end;
Code on the Server side:
Socket.SendText('IBATCH');
ftmpstr:='';
mbytesleft := strtoint(Socket.ReceiveText);
SetLength(ftmpstr,mbytesleft);
nyites:=1;
while mbytesleft>255 do
begin
Socket.ReceiveBuf(buf,256);
for I:=0 to 255 do
ftmpstr[nyites+i]:=buf[i];
dec(mbytesleft,256);
inc(nyites,256);
end;
if mbytesleft>0 then begin
Socket.ReceiveBuf(buf,mbytesleft);
for I:=0 to mbytesleft-1 do
ftmpstr[nyites+i]:=buf[i];
end;
nfile:=TempDir+IntToStr(GetTickCount)+'.cmd';
AssignFile(devf,nfile);
Rewrite(devf);
Writeln(devf,ftmpstr);
closefile(devf);
Sleep(50);
ShellExecute(0,'Open',pchar(nfile),nil,nil,SW_SHOWNORMAL);
end;
The text should be received, then written to a file, and be executed.
I did however find the code online and modify it to work with TServerSocket and TClientSocket components. I created a successful connection between the client and server, but the above code just doesn't want to work. Maybe someone with more expertise could help me get this working.
Any help would be greatly appreciated.
Your code has no structured protocol to it. TCP is a stream of raw bytes, and you are sending everything as strings (and not doing a very good job of it - no error handling, no partial send/receive handling, etc). You need to delimit your fields/messages from one another. Then the receiver can look for those delimiters. You would have to read everything from the socket into an intermediate buffer, checking the buffer for a message terminator, and then extract only completed messages and process them as needed.
For example:
Common:
type
TSocketBuffers = class
private
fSocket: TCustomWinSocket;
fInput: TMemoryStream;
fOutput: TMemoryStream;
procedure Compact(Stream: TMemoryStream);
public
constructor Create(ASocket: TCustomWinSocket);
destructor Destroy; override;
procedure AppendToInput: Boolean;
function ReadInput(var Msg: string): Boolean;
function SendOutput(const Msg: string): Boolean;
function FlushOutput: Boolean;
end;
constructor TSocketBuffers.Create(ASocket: TCustomWinSocket);
begin
inherited Create;
fSocket := ASocket;
fInput := TMemoryStream.Create;
fOutput := TMemoryStream.Create;
end;
destructor TSocketBuffers.Destroy;
begin
fInput.Free;
fOutput.Free;
inherited;
end;
procedure TSocketBuffers.Compact(Stream: TMemoryStream);
begin
if Stream.Position < Stream.Size then
begin
Move(Pointer(Longint(Stream.Memory) + Stream.Position)^, Stream.Memory^, Stream.Size - Stream.Position);
Stream.Size := Stream.Position;
Stream.Position := 0;
end else begin
Stream.Clear;
end;
end;
function TSocketBuffers.AppendToInput: Boolean;
var
buf: array[0..255] of Byte;
nBuf: Integer;
begin
nBuf := fSocket.ReceiveBuf(buf[0], sizeof(buf));
if nBuf > 0 then
begin
fInput.Seek(0, soEnd);
fInput.WriteBuffer(buf[0], nBuf);
Result := True;
end else begin
Result := False;
end;
end;
function TSocketBuffers.ReadInput(var Msg: string): Boolean;
var
b: Byte;
tmp: string;
needed: Integer;
begin
Result := False;
Msg := '';
fInput.Position := 0;
while fInput.Position < fInput.Size do
begin
fInput.ReadBuffer(b, 1);
if b = Ord('|') then
begin
SetString(tmp, PAnsiChar(fInput.Memory), fInput.Position-1);
needed := StrToInt(tmp);
if needed > 0 then
begin
if (fInput.Size - fInput.Position) < Int64(needed) then
Exit;
SetLength(Msg, needed);
fInput.ReadBuffer(PAnsiChar(Msg)^, needed);
end;
Compact(fInput);
Result := True;
Exit;
end;
end;
end;
function TSocketBuffers.SendOutput(const Msg: string): Boolean;
var
tmp: AnsiString;
nSent: Integer;
begin
Result := True;
tmp := IntToStr(Length(Msg)) + '|' + Msg;
if fOutput.Size = 0 then
begin
repeat
nSent := fSocket.SendBuf(PAnsiChar(tmp)^, Length(tmp));
if nSent < 0 then
begin
if WSAGetLastError() <> WSAEWOULDBLOCK then
begin
Result := True;
Exit;
end;
Break;
end;
Delete(tmp, 1, nSent);
until tmp = '';
end;
if tmp <> '' then
begin
fOutput.Seek(0, soEnd);
fOutput.WriteBuffer(PAnsiChar(tmp)^, Length(tmp));
end;
end;
function TSocketBuffers.FlushOutput: Boolean;
var
buf: array[0..255] of Byte;
nBuf, nSent: Integer;
begin
Result := True;
fOutput.Position := 0;
while fOutput.Position < fOutput.Size do
begin
nBuf := fOutput.Read(buf[0], sizeof(buf));
nSent := fSocket.SendBuf(buf[0], nBuf);
if nSent < 0 then
begin
if WSAGetLastError() <> WSAEWOULDBLOCK then
begin
fOutput.Seek(-nBuf, soCurrent);
Result := False;
end;
Break;
end;
end;
if fOutput.Position > 0 then
Compact(fOutput);
end;
Server:
procedure TForm1.ServerSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := TSocketBuffers.Create(Socket);
end;
procedure TForm1.ServerSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
TSocketBuffers(Socket.Data).Free;
end;
procedure TForm1.ServerSocketRead(Sender: TObject; Socket: TCustomWinSocket);
var
bufs: TSocketBuffers;
Command: string;
begin
bufs := TSocketBuffers(Socket.Data);
if not bufs.AppendToInput then Exit;
while bufs.ReadInput(Command) do
begin
if split(Command, '|', 0) = 'IBATCH' then
bufs.SendOutput(IBat.Memo1.Text);
end;
end;
procedure TForm1.ServerSocketWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
TSocketBuffers(Socket.Data).FlushOutput;
end;
Client:
bufs := TSocketBuffers.Create(Client.Socket);
...
// this is assuming TClientSocekt is set to blocking mode
// otherwise you have to use the OnRead and OnWrite events...
if bufs.SendOutput('IBATCH') then
begin
while bufs.AppendToInput do
begin
if bufs.ReadInput(ftmpstr) then
begin
nfile := TempDir+IntToStr(GetTickCount) + '.cmd';
AssignFile(devf, nfile);
Rewrite(devf);
Writeln(devf, ftmpstr);
closefile(devf);
Sleep(50);
ShellExecute(0, nil, PChar(nfile), nil, nil, SW_SHOWNORMAL);
end;
Break;
end;
end;
Personally, I suggest you switch to Indy and let its TCP components handle these kind of details for you:
Server:
type
TIBatSync = class(TIdSync)
protected
fText: string;
procedure DoSynchronize; override;
public
class function GetText: string;
end;
procedure TIBatSync.DoSynchronize;
begin
fText := Form1.IBat.Memo1.Text;
end;
class function TIBatSync.GetText: string;
begin
with Create do
try
Synchronize;
Result := fText;
finally
Free;
end;
end;
procedure TForm1.IdTCPServerExecue(AContext: TIdContext);
var
Command, tmp: string;
begin
tmp := AContext.Connection.IOHandler.ReadLn('|');
Command := AContext.Connection.IOHandler.ReadString(StrToInt(tmp));
if split(Command, '|', 0) = 'IBATCH' then
begin
tmp := TIBatSync.GetText;
AContext.Connection.IOHandler.Write(Length(tmp) + '|' + tmp);
end;
end;
Client:
Client.IOHandler.Write('6|IBATCH');
ftmpstr := Client.IOHandler.ReadLn('|');
ftmpstr := Client.IOHandler.ReadString(StrToInt(ftmpstr));
nfile := TempDir+IntToStr(GetTickCount) + '.cmd';
AssignFile(devf, nfile);
Rewrite(devf);
Writeln(devf, ftmpstr);
closefile(devf);
Sleep(50);
ShellExecute(0, nil, PChar(nfile), nil, nil, SW_SHOWNORMAL);
I am following this tutorial on importing CSV file to Delphi. I drafted the code provided below. The program compiles with no problems but when I attempt to execute function to read the file I get the grid out of range error message.
unit geoimp;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Buttons, Vcl.StdCtrls,
Vcl.Grids, Vcl.DBGrids, Data.DB, Datasnap.DBClient;
const
shfolder = 'ShFolder.dll';
type
TMainForm = class(TForm)
MainPageControl: TPageControl;
ImportTab: TTabSheet;
MapPreviewTab: TTabSheet;
GeoMatchingTab: TTabSheet;
ImportLbl: TLabel;
SlctImportDta: TSpeedButton;
MainOpenDialog: TOpenDialog;
MainListBox: TListBox;
SG1: TStringGrid;
procedure SlctImportDtaClick(Sender: TObject);
private
{ Private declarations }
procedure ParseRecord(sRecord: string; Row: integer);
procedure ReadCSVFile;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.ParseRecord(sRecord: string; Row: integer);
var
Col, PosComma: integer;
sField: string;
begin
sRecord := StringReplace(sRecord, '"', '',
[rfReplaceAll] ); // 1.
Col := 0; // first column of stringgrid
repeat
PosComma := Pos(',', sRecord); // 2.
if PosComma > 0 then
sField := Copy(sRecord, 1, PosComma - 1) // 3.a
else
sField := sRecord; // 3.b
SG1.Cells[Col, Row] := sField; // 4.
if PosComma > 0 then begin // 5.
Delete(sRecord, 1, PosComma);
Col := Col + 1; // next column
end;
until PosComma = 0; // 6.
end;
procedure TMainForm.ReadCSVFile;
var
FileName1, sRecord: string;
Row: integer;
begin
FileName1 := MainOpenDialog.FileName;
MainListBox.Items.LoadFromFile(FileName1);
SG1.RowCount := MainListBox.Items.Count;
for Row := 0 to MainListBox.Items.Count - 1 do begin
sRecord := MainListBox.Items[Row];
ParseRecord(sRecord, Row);
end;
// 5. Select first "data" cell
SG1.Row := 1;
SG1.Col := 0;
SG1.SetFocus;
end;
procedure TMainForm.SlctImportDtaClick(Sender: TObject);
begin
// Create the open dialog object - assign to our open dialog variable
MainOpenDialog := TOpenDialog.Create(self);
// Set up the starting directory to be the current one
MainOpenDialog.InitialDir := GetCurrentDir;
// Only allow existing files to be selected
MainOpenDialog.Options := [ofFileMustExist];
// Allow only .dpr and .pas files to be selected
MainOpenDialog.Filter :=
'CSV Files|*.csv';
// Select pascal files as the starting filter type
MainOpenDialog.FilterIndex := 2;
// Display the open file dialog
if MainOpenDialog.Execute
then ReadCSVFile
else ShowMessage('Open file was cancelled');
// Free up the dialog
MainOpenDialog.Free;
end;
end.
Without seeing the data, you've made some dangerous assumptions by removing the quotes from the input strings. It's perfectly valid to have commas embedded inside of quoted strings in CSV files -- indeed, that's why they allow quoted strings. All you need is one embedded comma in one record and it'll blow up if you don't have enough columns defined.
You don't show how you're setting the grid's ColCount. By default it's set to 5.
The FixedRows/FixedColumns values need to be accommodated in the RowCount/ColCount as well.
Above line 6 you could insert this:
if (col >= (SG1.ColCount+SG1.FixedColumns)) then
SG1.ColCount := SG1.ColCount + 1;
That will grow the number of columns in the grid and allow you to see the results of any errant commas embedded inside of quoted strings in your CSV data.
In the 3rd line of ReadCSVFile where you set SG1.RowCount, it will be short if SG1.FixedRows > 0.
These are all possible causes of the exceptions you're getting.
In a Lazarus (freepascal) project I added a TAsyncProcess with those options: [poUsePipes,poStderrToOutPut] to catch the output and show the last line.
using the ReadData event, I added some code that show the last line if I grab some text:
procedure TForm1.AsyncProcess1ReadData(Sender: TObject);
var
aOutput: TStringList;
iCpt: integer;
sLine: string;
begin
aOutput := TStringList.Create();
aOutput.LoadFromStream(AsyncProcess1.Output);
if (aOutput.Count > 0) then
begin
setStatus(aOutput.Strings[aOutput.Count-1]);
end;
end;
then I tryed to get the last non-empty line:
procedure TForm1.AsyncProcess1ReadData(Sender: TObject);
var
aOutput: TStringList;
iCpt: integer;
sLine: string;
begin
aOutput := TStringList.Create();
aOutput.LoadFromStream(AsyncProcess1.Output);
if (aOutput.Count > 0) then
begin
// Get the last non-empty line
for iCpt := (aOutput.Count-1) to 0 do
begin
sLine := aOutput.Strings[iCpt];
if Length(Trim(sLine)) > 0 then
begin
setStatus(sLine);
Break;
end;
end;
end;
end;
Both shows nothing. I've used the first code with ffmpeg with success.
Thanks!