Pascal: Will not read anything from my file and getting errors - pascal

I've been stressing out for the past few hours trying to get this working and I simply cannot figure it out. Basically it doesn't read anything from my .dat file and when I try to use options 2, 3 or 4 it just comes up with these
.
I've include the .dat file and pascal below. I'm desperate for help.
mytestfile.dat
1
Adele
Pop
2
Hello
ff
Remedy
dd
pascal
program MusicPlayer;
uses TerminalUserInput;
type
TrackRec = record
name: String;
location: String;
end;
// type TrackArray = array of TrackRec;
GenreType = (Pop, Rap, Rock, Classic);
AlbumRec = Record
name: String;
genre: GenreType;
// location: array of TrackRec;
tracks: array of TrackRec;
end;
type AlbumArray = array of AlbumRec;
function ReadGenre(): GenreType;
var
option: Integer;
begin
WriteLn('Press 1 for Pop');
WriteLn('Press 2 for Rap');
WriteLn('Press 3 for Rock');
WriteLn('Press 4 for Classic');
option := ReadInteger('');
while (option<1) or (option>5) do
begin
WriteLn('Please enter a number between 1-4');
option := ReadInteger('');
end;
case option of
1: result := Pop;
2: result := Rap;
3: result := Rock;
else
result := Classic;
end;
end;
procedure NewAlbum(var albums: AlbumArray; var myFile: TextFile);
var
number, i, tracks, y: Integer;
begin
AssignFile(myFile, 'mytestfile.dat');
ReWrite(myFile);
number := ReadInteger('How many albums do you want to make?: ');
WriteLn(myFile, number);
SetLength(albums, number);
for i := Low(albums) to High(albums) do
begin
albums[i].name := ReadString('Enter album name:');
WriteLn(myFile, albums[i].name);
albums[i].genre := ReadGenre();
WriteLn(myFile, albums[i].genre);
tracks := ReadIntegerRange('How many tracks do you want to enter? (max 15)', 0, 15);
WriteLn(myFile, tracks);
SetLength(albums[i].tracks, tracks);
for y := Low(albums[i].tracks) to tracks - 1 do
begin
albums[i].tracks[i].name := ReadString('Track name:');
WriteLn(myFile, albums[i].tracks[i].name);
albums[i].tracks[i].location := ReadString('Track Location:');
WriteLn(myFile, albums[i].tracks[i].location);
end;
end;
Close(myFile);
end;
procedure ReadTrack(count: Integer; var albums: AlbumArray; var myFile: TextFile);
var
i: Integer;
begin
ReadLn(myFile, i);
SetLength(albums[count].tracks, i);
for count := Low(albums[count].tracks) to High(albums[count].tracks) - 1 do
begin
ReadLn(myFile, albums[count].tracks[i].name);
ReadLn(myFile, albums[count].tracks[i].location);
end;
end;
procedure ReadAlbum(var albums: AlbumArray; var myFile: TextFile);
var
albumNumber, tracknumber, count, i: Integer;
begin
AssignFile(myFile, 'mytestfile.dat');
Reset(myFile);
ReadLn(myFile, albumNumber);
SetLength(albums, albumNumber);
for i := Low(albums) to High(albums) do
begin
ReadLn(myFile, albums[i].name);
ReadLn(myFile, albums[i].genre);
ReadLn(myFile, tracknumber);
SetLength(albums[i].tracks, tracknumber);
for count := Low(albums[count].tracks) to tracknumber - 1 do
begin
ReadLn(myFile, albums[count].tracks[i].name);
ReadLn(myFile, albums[count].tracks[i].location);
end;
end;
end;
procedure ReadAlbums(var albums: AlbumArray; var myFile: TextFile);
var
i, number: Integer;
begin
ReadAlbum(albums, myFile);
WriteLn('Album is:');
for i := Low(albums) to High(albums) do
begin
WriteLn((i + 1),'.', albums[i].name);
WriteLn('.', albums[i].genre);
for number := Low(albums[i].tracks) to High(albums[i].tracks) do
begin
WriteLn((number + 1), '', albums[i].tracks[Low(albums[i].tracks)].name);
end;
end;
end;
procedure PlayAlbum (var albums: AlbumArray; var myFile: TextFile);
var
i, number: Integer;
begin
ReadAlbums(albums, myFile);
i := ReadInteger('Please select an album: ');
i := i - 1;
number := ReadIntegerRange('Please select a song from album:', 1, 20);
number := number - 1;
WriteLn('Now playing');
WriteLn('Track selected: ', albums[i].tracks[number].name);
WriteLn('Album: ', albums[i].name);
end;
procedure Update(var albums: AlbumArray; var myFile: TextFile);
var
i: Integer;
begin
ReadAlbums(albums, myFile);
i := ReadInteger('Select an album to update');
i := i - 1;
albums[i].name := ReadString('New Album Name:');
WriteLn('Album has now been updated');
end;
procedure Main();
var
i, count, select, change: Integer;
albums: AlbumArray;
myFile: TextFile;
begin
WriteLn('Please select an option: ');
WriteLn('-------------------------');
WriteLn('1. Read Albums');
WriteLn('2. Display Albums');
WriteLn('3. Select an Album');
WriteLn('4. Update an Album');
WriteLn('5. Exit');
WriteLn('-------------------------');
repeat
i := ReadInteger('Select option for menu:');
case i of
1: ReadAlbum(albums, myFile);
2: ReadAlbums(albums, myFile);
3: PlayAlbum(albums, myFile);
4: Update(albums, myFile);
end;
until i = 5;
end;
begin
Main();
end.

In the ReadAlbum() procedure you have two for loops, an outer one that loops through the albums and an inner one that loops through the tracks. In the latter you have messed up the indexes:
This is the erroneous code:
for count := Low(albums[count].tracks) to tracknumber - 1 do
begin
ReadLn(myFile, albums[count].tracks[i].name);
ReadLn(myFile, albums[count].tracks[i].location);
end;
albums[] should use i as index and tracks[] should use count as index.
Until you get more used to arrays and indexes I suggest you name your variables with a clear meaning, for example:
`NumOfAlbums` in the meaning of how many albums you have
`AlbumIndex` as the index to the albums array
`NumOfTracks` as the number of tracks in an album
`TrackIndex` as the index to the tracks array
It may feel tiresome to write so long names, but you would probably not have made the mistake you did, with the more verbose names.

Related

As in Delphi at ctrl + a to allocate all line in dbgrid

did when pressing button select all the lines in dbgrid, can I select all the lines when ctrl + a is pressed?
function GridSelectAll(Grid: TDBGrid): Longint;
begin
Result := 0;
Grid.SelectedRows.Clear;
with Grid.Datasource.DataSet do
begin
First;
DisableControls;
try
while not EOF do
begin
Grid.SelectedRows.CurrentRowSelected := True;
inc(Result);
Next;
end;
finally
EnableControls;
end;
end;
end;
procedure TForm2.btn13Click(Sender: TObject);
begin
GridSelectAll(dbgrd1);
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (ssCtrl in Shift) and (Key = $41) then
then GridSelectAll(dbgrd1); end;

Oracle loop through CLOB to get string

I want to convert all data in CLOB to string. DBMC_LOB.SUBSTR provides a way to fetch 4000 characters at once. I am from MS SQL background and not aware of Oracle queries. Can someone help me with the syntax.
I want to make a function and do something like
// Get the length of CLOB
// totalIterationsRequired = length/4000;
// LOOP around the CLOB and fetch 4000 char at once
For i in 1..totalIterationsRequired
LOOP
// Insert the substring into a varchar2
// DBMC_LOB.SUBSTR(xml_value,4000*i,(4000*(i-1)+1)
END LOOP
// The function will return the varchar2
create table save_table(rec varchar2(4000));
create or replace PROCEDURE save_clob (p_clob IN CLOB)
AS
l_length INTEGER;
l_start INTEGER := 1;
l_recsize CONSTANT INTEGER := 4000;
BEGIN
l_length := DBMS_LOB.getlength (p_clob);
WHILE l_start <= l_length
LOOP
INSERT INTO save_table (rec)
VALUES (DBMS_LOB.SUBSTR (p_clob, l_recsize, l_start));
l_start := l_start + l_recsize;
END LOOP;
END save_clob;
Below is the function definition
create or replace function getclobastable (id IN VARCHAR2)
return clob_table
is
l_length INTEGER;
l_start INTEGER := 1;
l_recsize CONSTANT INTEGER := 4000;
i_clob CLOB;
n BINARY_INTEGER := 0;
save_table clob_table := clob_table();
BEGIN
save_table := clob_table();
-- Get the CLOB data into i_clob
l_length := DBMS_LOB.getlength (i_clob);
WHILE l_start <= l_length
LOOP
n := n + 1;
save_table.EXTEND();
save_table(n) := DBMS_LOB.SUBSTR (i_clob, l_recsize, l_start);
l_start := l_start + l_recsize;
END LOOP;
RETURN save_table;
END;

TidTcpserver Verify commands List

I Am trying to protect my Tidtcpserver from unknown commands
This is how my Verify commands function looks like
function TConnection.Verfieycmds(const CMSTOV: String): BOOLEAN;
var
CMDSTOVERFIYE : Tstringlist;
I : integer;
CommandFound : Boolean;
begin
Result := False;
CommandFound := False;
if Commandlist <> nil then
begin
CMDSTOVERFIYE := Commandlist.Lock;
try
for I := 0 to CMDSTOVERFIYE.Count - 1 do
begin
if CMSTOV = CMDSTOVERFIYE[I] then
begin
CommandFound := True;
end;
end;
CommandFound := True;
Result := CommandFound;
finally
Commandlist.Unlock;
end;
end;
end;
after adding this check on execute event and after few clients connect the server application freezed and need to be restarted and the exception log were empty
here is my server code
type
TConnection = class(TIdServerContext)
private
{Private}
public
{Public}
OutboundCache: TIdThreadSafeStringList;
Commandlist: TIdThreadSafeStringList;
LastSendRecv: TIdTicks;
Name: String;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
end;
type
TServobj = class(TForm)
TcpServer: TIdTCPServer;
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
procedure TcpServerConnect(AContext: TIdContext);
procedure TcpServerDisconnect(AContext: TIdContext);
procedure TcpServerExecute(AContext: TIdContext);
procedure FormCloseQuery(Sender: TObject; var CanClose: BOOLEAN);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TcpServerListenException(AThread: TIdListenerThread;
AException: Exception);
private
{ Private declarations }
LastUniqueID: Dword;
procedure HandleExceptions(Sender: TObject; E: Exception);
procedure UpdateBindings;
public
{ Public declarations }
end;
var
Servobj: TServobj;
implementation
uses
dmoudle;
{$R *.dfm}
constructor TConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
AList: TIdContextThreadList = nil);
begin
inherited;
OutboundCache := TIdThreadSafeStringList.Create;
Commandlist := TIdThreadSafeStringList.Create;
Commandlist.Add('Command1');
Commandlist.Add('Command2');
Commandlist.Add('Command3');
Commandlist.Add('Command4');
Commandlist.Add('Command5');
Commandlist.Add('Command6');
Commandlist.Add('Command7');
Commandlist.Add('Command8');
Commandlist.Add('Command9');
Commandlist.Add('Command10');
Commandlist.Add('Command11');
Commandlist.Add('Command12');
end;
destructor TConnection.Destroy;
var
Cache: TStringList;
Commadcaches : TStringList;
I: integer;
begin
if OutboundCache <> nil then
begin
Cache := OutboundCache.Lock;
try
for I := 0 to Cache.Count - 1 do
Cache.Objects[I].Free;
finally
OutboundCache.Unlock;
end;
OutboundCache.Free;
end;
if Commandlist <> nil then
begin
Commadcaches := Commandlist.Lock;
try
for I := 0 to Commadcaches.Count - 1 do
Commadcaches.Objects[I].Free;
finally
Commandlist.Unlock;
end;
Commandlist.Free;
end;
inherited;
end;
procedure TServobj.TcpServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Startercommand : String;
Params: array [1 .. 200] of String;
Cache, OutboundCmds: TStringList;
ParamsCount, P: integer;
I: integer;
S: String;
DECODES : String;
UConnected : Boolean;
Len: Integer;
begin
Try
UConnected := AContext.Connection.Connected;
Except
UConnected := False;
End;
If Not UConnected Then
begin
AContext.Connection.Disconnect;
exit;
end;
Len := AContext.Connection.IOHandler.InputBuffer.Size;
If Len >= 200000 then
begin
AContext.Connection.Disconnect;
exit;
end;
Connection := AContext as TConnection;
// check for pending outbound commands...
OutboundCmds := nil;
try
Cache := Connection.OutboundCache.Lock;
try
if Cache.Count > 0 then
begin
OutboundCmds := TStringList.Create;
OutboundCmds.Assign(Cache);
Cache.Clear;
end;
finally
Connection.OutboundCache.Unlock;
end;
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
AContext.Connection.IOHandler.Writeln(OutboundCmds.Strings[I],
IndyTextEncoding_UTF8);
MS := TMemoryStream(OutboundCmds.Objects[I]);
if MS <> nil then
begin
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
AContext.Connection.IOHandler.LargeStream := true;
AContext.Connection.IOHandler.Write(MS, 0, true);
end;
end;
Connection.LastSendRecv := Ticks64;
end;
finally
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
OutboundCmds.Objects[I].Free;
end;
end;
OutboundCmds.Free;
end;
// check for a pending inbound command...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(100);
AContext.Connection.IOHandler.CheckForDisconnect;
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
if GetElapsedTicks(Connection.LastSendRecv) >= 60000 then
AContext.Connection.Disconnect;
Exit;
end;
end;
Startercommand := Decode64(AContext.Connection.Socket.ReadLn(IndyTextEncoding_UTF8), IndyTextEncoding_UTF8);
Command := Startercommand;
{HERE I START TO CHECK COMMAND LIST}
if (command <> 'ISACTIVE') then
begin
if Connection.Verfieycmds(Command) <> true then
begin
AContext.Connection.Disconnect;
Exit;
end;
end;
{HERE I START TO CHECK COMMAND LIST}
Connection.LastSendRecv := Ticks64;
if Command = '' then
begin
AContext.Connection.Disconnect;
Exit;
end;
ReceiveParams := False;
ReceiveStream := False;
if Command[1] = '1' then // command with params
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := true;
end
else if Command[1] = '2' then // command + memorystream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveStream := true;
end
else if Command[1] = '3' then // command with params + memorystream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := true;
ReceiveStream := true;
end;
if ReceiveParams then // params is incomming
begin
S := AContext.Connection.Socket.ReadLn(IndyTextEncoding_UTF8);
DECODES := Decode64(S, IndyTextEncoding_UTF8);
ParamsCount := 0;
while (DECODES <> '') and (ParamsCount < 200) do
begin
Inc(ParamsCount);
P := Pos(Sep, DECODES);
if P = 0 then
Params[ParamsCount] := DECODES
else
begin
Params[ParamsCount] := Copy(DECODES, 1, P - 1);
Delete(DECODES, 1, P + 5);
end;
end;
end;
if Command = 'Broadcastanymessage' then
begin
if ParamsCount <> 3 then
begin
AContext.Connection.Disconnect;
Exit;
end;
//do something
end;
end;
if i remove the Verfieycmds from the execute check the server running normally . what i am doing wrong ?
There is no reason to use a TIdThreadSafeStringList for the commands list. Only the thread that creates the list will ever be accessing it, so using a lock for it is unnecessary overhead.
And there is no reason to allocate a new list for each client, for that matter. That is just wasting memory.
Your commands are encoded in a manner that requires decoding before you can then validate them.
Try something more like this instead:
type
TConnection = class(TIdServerContext)
private
function HasInboundData: Boolean;
procedure SendOutboundCache;
public
OutboundCache: TIdThreadSafeStringList;
LastSendRecv: TIdTicks;
// ...
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
end;
type
TServobj = class(TForm)
TcpServer: TIdTCPServer;
//...
procedure TcpServerConnect(AContext: TIdContext);
//...
procedure TcpServerExecute(AContext: TIdContext);
procedure FormCreate(Sender: TObject);
//...
private
//...
end;
var
Servobj: TServobj;
implementation
uses
dmoudle;
{$R *.dfm}
constructor TConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
OutboundCache := TIdThreadSafeStringList.Create;
LastSendRecv := Ticks64;
end;
destructor TConnection.Destroy;
var
Cache: TStringList;
I: integer;
begin
if OutboundCache <> nil then
begin
Cache := OutboundCache.Lock;
try
for I := 0 to Cache.Count - 1 do
Cache.Objects[I].Free;
finally
OutboundCache.Unlock;
end;
OutboundCache.Free;
end;
inherited;
end;
function TConnection.HasInboundData: Boolean;
begin
if Connection.IOHandler.InputBufferIsEmpty then
begin
Connection.IOHandler.CheckForDataOnSource(100);
Connection.IOHandler.CheckForDisconnect;
if Connection.IOHandler.InputBufferIsEmpty then
begin
if GetElapsedTicks(LastSendRecv) >= 60000 then
Connection.Disconnect;
Result := False;
Exit;
end;
end;
Result := True;
end;
procedure TConnection.SendOutboundCache;
var
Cache, OutboundCmds: TStringList;
MS: TMemoryStream;
I: integer;
begin
OutboundCmds := nil;
try
Cache := OutboundCache.Lock;
try
if Cache.Count = 0 then
Exit;
OutboundCmds := TStringList.Create;
OutboundCmds.Assign(Cache);
Cache.Clear;
finally
OutboundCache.Unlock;
end;
for I := 0 to OutboundCmds.Count - 1 do
begin
Connection.IOHandler.WriteLn(OutboundCmds.Strings[I]);
MS := TMemoryStream(OutboundCmds.Objects[I]);
if MS <> nil then
begin
Connection.IOHandler.LargeStream := true;
Connection.IOHandler.Write(MS, 0, true);
end;
end;
LastSendRecv := Ticks64;
finally
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
OutboundCmds.Objects[I].Free;
end;
end;
OutboundCmds.Free;
end;
end;
procedure TServobj.FormCreate(Sender: TObject);
begin
TcpServer.ContextClass := TConnection;
end;
procedure TServobj.TcpServerConnect(AContext: TIdContext);
begin
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8
end;
const
ValidCmds: array[0..13] of String = (
'ISACTIVE',
'Broadcastanymessage',
'Command1',
'Command2',
'Command3',
'Command4',
'Command5',
'Command6',
'Command7',
'Command8',
'Command9',
'Command10',
'Command11',
'Command12'
);
procedure TServobj.TcpServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command, Decoded: String;
Params: array[1..200] of String;
ParamsCount, P, I, WhichCmd: integer;
begin
Connection := AContext as TConnection;
// check for pending outbound commands...
Connection.SendOutboundCache;
// check for a pending inbound command...
if not Connection.HasInboundData then
Exit;
Command := Decode64(AContext.Connection.IOHandler.ReadLn, IndyTextEncoding_UTF8);
ReceiveParams := False;
ReceiveStream := False;
if Command <> '' then
begin
if Command[1] = '1' then // command with params
begin
Delete(Command, 1, 1);
ReceiveParams := true;
end
else if Command[1] = '2' then // command + memorystream
begin
Delete(Command, 1, 1);
ReceiveStream := true;
end
else if Command[1] = '3' then // command with params + memorystream
begin
Delete(Command, 1, 1);
ReceiveParams := true;
ReceiveStream := true;
end;
end;
WhichCmd := PosInStrArray(Command, ValidCmds);
if WhichCmd = -1 then
begin
AContext.Connection.Disconnect;
Exit;
end;
if ReceiveParams then // params is incomming
begin
Decoded := Decode64(AContext.Connection.IOHandler.ReadLn, IndyTextEncoding_UTF8);
ParamsCount := 0;
while (Decoded <> '') and (ParamsCount < 200) do
begin
Inc(ParamsCount);
P := Pos(Sep, Decoded);
if P = 0 then
Params[ParamsCount] := Decoded
else
begin
Params[ParamsCount] := Copy(Decoded, 1, P - 1);
Delete(Decoded, 1, P + Length(Sep));
end;
end;
end;
Connection.LastSendRecv := Ticks64;
case WhichCmd of
// process commands as needed...
1: begin // Broadcastanymessage
if ParamsCount <> 3 then
begin
AContext.Connection.Disconnect;
Exit;
end;
//do something
end;
// ...
end;
end;

Procedure and function. Return one big string

I writing this procedure and I have question how can I overwrite old value on new Value and return the new line with new big one string with new mails.
Procedure split one big email which have got emails on few single mails and change domain.
Perception: I got one table with atributes example Values which have one big string with emails. I must change this emails to domain NewDomain.pl when its diffrent from aaa.pl and bbb.pl when its the same I leave this emails. example:
Old Value: 'zamowienia#kicius.pl mickey.mouse#aaa.pl kimus.walus#domek.pl'
and result I want update:
**New Value: 'zamowienia#NewDomain.pl mickey.mouse#aaa.pl kimus.walus#NewDomain.pl'
First procedure:
CREATE OR REPLACE PROCEDURE changeMailAll
AS
BEGIN
DECLARE delim char(3);
cur_position INTEGER(11) DEFAULT 1;
r_remainder VARCHAR(250);
cur_string VARCHAR(1000);
delim_length INTEGER;
length_remainder INTEGER;
mail VARCHAR(255);
MAILs VARCHAR(20000);
v_value VARCHAR2(255);
v_valueNew VARCHAR2(255);
v_customerId VARCHAR(20);
c INTEGER;
d INTEGER;
positionMonkey INTEGER;
v_identity VARCHAR(50);
domena VARCHAR2(50);
v_loop VARCHAR(100);
adres VARCHAR(255);
**str PKT_StringFnc.t_array;**
CURSOR cursorMails IS
SELECT Customer_Id, Value FROM PKT_userTrue where method_id = 'E_MAIL';
BEGIN
OPEN cursorMails;
LOOP
FETCH cursorMails INTO v_customerId, v_value;
**str := PKT_StringFnc.SPLIT(v_value,' ');
FOR i IN 1..str.COUNT LOOP
dbms_output.put_line('XXX1' || str(i));
END LOOP;**
EXIT WHEN cursorMails%NOTFOUND;
END LOOP;
CLOSE cursorMails;
END;
END;
End Second procedure where I split mail from first procedure
CREATE OR REPLACE PACKAGE BODY PKT_StringFnc
IS
FUNCTION SPLIT (p_in_string VARCHAR2, p_delim VARCHAR2) RETURN t_array
IS
i number :=0;
pos number :=0;
lv_str varchar2(255) := p_in_string;
positionMonkey INTEGER;
domena VARCHAR2(50);
adres VARCHAR(255);
lv_str_new VARCHAR2(255);
aaa VARCHAR(20) := '#aaa.pl ';
bbb VARCHAR(30) := '#bbb.pl ';
result VARCHAR(1000);
strings t_array;
BEGIN
pos := instr(lv_str,p_delim,1,1);
WHILE ( pos != 0) LOOP
i := i + 1;
strings(i) := substr(lv_str,1,pos);
positionMonkey := INSTR(strings(i),'#');
domena := SUBSTR(strings(i), positionMonkey);
adres := RTRIM(strings(i),domena);
lv_str := substr(lv_str,pos+1,length(lv_str));
pos := instr(lv_str,p_delim,1,1);
IF pos = 0 THEN
strings(i+1) := lv_str;
ELSE
strings(i+1) := lv_str_new;
END IF;
IF domena = aaa OR domena = bbb THEN
lv_str_new := REPLACE(strings(i),domena,'#NewDomain.com');
END IF;
DBMS_OUTPUT.PUT_LINE('lv_str_newREPLACE:'|| lv_str_new);
END LOOP;
RETURN strings;
END SPLIT;
END;
/
When I return one big string I want update in table and where I can do it ?
Thanks for help
Maybe somebody can rewrite easiest procedure from two to one procedure
I wonder if something like
UPDATE pktTrue
SET Value = REGEXP_REPLACE(Value, '(#aaa.pl)|(#bbb.pl)|(#[a-zA-Z0-9._%-]+\.[a-zA-Z]{2,4})', '\1\2#NewDomain.pl', 1, 0, 'c')
WHERE method_id = 'E_MAIL';
will work for you?

How to simple change node's attribute value of XMLTYPE in Oracle 11g r2?

I just wanna to change in this XML (contained in XMLTYPE variable) all nodes named "ChildNode" with "Name"="B" attribute values to "C":
<RootNode>
<ChildNodes>
<ChildNode Name="A"/>
<ChildNode Name="B"/>
</ChildNodes>
</RootNode>
DECLARE
FXML XMLTYPE;
BEGIN
FXML := ...; -- see text before
-- what next?
END;
Thanks!
You can use updatexml function:
declare
fOrigXml XmlType := XmlType(
'<RootNode>
<ChildNodes>
<ChildNode Name="A"/>
<ChildNode Name="B"/>
</ChildNodes>
</RootNode>');
fResXml XmlType;
begin
select updatexml((fOrigXml), '/RootNode/ChildNodes/ChildNode[#Name="B"]/#Name', 'C') into fResXml from dual;
end;
One more:
SET SERVEROUTPUT ON;
DECLARE
DOC DBMS_XMLDOM.DOMDocument;
var XMLTYPE := XMLType('<RootNode>
<ChildNodes>
<ChildNode Name="A"/>
<ChildNode Name="B"/>
</ChildNodes>
</RootNode>');
xmlvalue CLOB;
PROCEDURE changeNameAttributes(
DOC dbms_xmldom.domdocument)
IS
nl dbms_xmldom.domnodelist;
v_clob CLOB;
LEN NUMBER;
n dbms_xmldom.domnode;
nodename VARCHAR2(4000);
nodevalue VARCHAR2(4000);
PROCEDURE changeAttributeB(
n dbms_xmldom.domnode)
IS
e dbms_xmldom.domelement;
dn dbms_xmldom.domnode;
nnm dbms_xmldom.domnamednodemap;
attrname VARCHAR2(100);
attrval VARCHAR2(100);
LEN NUMBER;
BEGIN
e := dbms_xmldom.makeelement(n); -- get all attributes of element
nnm := xmldom.getattributes(n);
IF(xmldom.isnull(nnm) = FALSE) THEN
LEN := dbms_xmldom.getlength(nnm); -- loop through attributes
FOR i IN 0 .. LEN -1
LOOP
dn := dbms_xmldom.item(nnm, i);
attrname := dbms_xmldom.getnodename(dn);
IF(attrname = 'Name' ) THEN
attrval := dbms_xmldom.getnodevalue(dn);
IF(attrval = 'B') THEN
dbms_xmldom.setnodevalue(dn,'C');
END IF;
END IF;
END LOOP;
END IF;
END changeAttributeB;
BEGIN
nl := dbms_xmldom.getelementsbytagname(DOC, '*');
LEN := dbms_xmldom.getlength(nl);
FOR i IN 0 .. LEN -1
LOOP
n := dbms_xmldom.item(nl, i);
nodename := dbms_xmldom.getnodename(n);
IF ( nodename = 'ChildNode') THEN
changeAttributeB(n);
END IF;
END LOOP;
END changeNameAttributes;
BEGIN
DOC := DBMS_XMLDOM.newDOMDocument(var);
--Before
DBMS_OUTPUT.PUT_LINE('BEFORE');
DBMS_LOB.createtemporary (xmlvalue, TRUE);
DBMS_XMLDOM.writeToClob(DOC, xmlvalue);
DBMS_OUTPUT.PUT_LINE(xmlvalue);
-- Modify
changeNameAttributes(DOC);
-- After
DBMS_OUTPUT.PUT_LINE('AFTER');
DBMS_XMLDOM.writeToClob(DOC, xmlvalue);
DBMS_OUTPUT.PUT_LINE(xmlvalue);
dbms_xmldom.freedocument(DOC);
END;
/
Here is one solution:
Declare
xml_nl DBMS_XMLDOM.DOMNodeList;
xml_node DBMS_XMLDOM.DOMNode;
xml_doc DBMS_XMLDOM.DOMDocument;
v_xml_clob CLOB;
v_name VARCHAR2(32767);
v_xml VARCHAR2(32767) :=
'<RootNode>
<ChildNodes>
<ChildNode Name="A"/>
<ChildNode Name="B"/>
</ChildNodes>
</RootNode>';
Begin
xml_doc := DBMS_XMLDOM.NewDOMDocument(XMLType.createXML(v_xml));
xml_nl := DBMS_XMLDOM.GetElementsByTagName(xml_doc, 'ChildNode');
FOR i IN 0 .. (DBMS_XMLDOM.getLength(xml_nl) - 1) LOOP
xml_node := DBMS_XMLDOM.Item(xml_nl, i);
DBMS_XSLPROCESSOR.valueOf(xml_node, '#Name', v_name);
IF v_name IS NOT NULL AND v_name = 'B' THEN
DBMS_XMLDOM.setAttribute(DBMS_XMLDOM.makeElement(xml_node), 'Name', 'C');
END IF;
END LOOP;
DBMS_LOB.createTemporary(v_xml_clob, cache => FALSE);
DBMS_LOB.Open(v_xml_clob, DBMS_LOB.lob_readwrite);
DBMS_XMLDOM.writeToCLob(xml_doc, v_xml_clob);
DBMS_OUTPUT.put_line(v_xml_clob);
End;
/* Formatted on 6/19/2016 3:02:05 PM (QP5 v5.126) */
DECLARE
var XMLTYPE;
doc DBMS_XMLDOM.domdocument;
ndoc DBMS_XMLDOM.domnode;
docelem DBMS_XMLDOM.domelement;
node DBMS_XMLDOM.domnode;
childnode DBMS_XMLDOM.domnode;
nodelist DBMS_XMLDOM.domnodelist;
nodelist2 DBMS_XMLDOM.domnodelist;
buf VARCHAR2 (2000);
newnode DBMS_XMLDOM.domnode;
clonenode DBMS_XMLDOM.domnode;
elem DBMS_XMLDOM.domelement;
PROCEDURE duyethoiquy (clonenode IN OUT DBMS_XMLDOM.domnode)
IS
childnode DBMS_XMLDOM.domnode;
simpletypechildnodemap DBMS_XMLDOM.domnamednodemap;
simpletypeattributenode DBMS_XMLDOM.domnode;
BEGIN
-- xu ly clonenode nay
-- sau do lay may con de duyet tiep
-- thay doi node con lev 1..
IF NOT DBMS_XMLDOM.isnull (clonenode)
THEN
-- xu ly node nay
-- thay doi mot vai thuoc tinh cua cay nay
simpletypechildnodemap := DBMS_XMLDOM.getattributes (clonenode);
simpletypeattributenode :=
DBMS_XMLDOM.getnameditem (simpletypechildnodemap, 'r');
IF NOT DBMS_XMLDOM.isnull (simpletypeattributenode)
THEN
DBMS_XMLDOM.setnodevalue (simpletypeattributenode, '');
DBMS_XMLDOM.writetobuffer (simpletypeattributenode, buf);
DBMS_OUTPUT.put_line ('attr:' || buf);
END IF;
IF DBMS_XMLDOM.haschildnodes (clonenode)
THEN
childnode := DBMS_XMLDOM.getfirstchild (clonenode);
--- ghi nhan gia tri
WHILE NOT DBMS_XMLDOM.isnull (childnode)
LOOP
-- xu ly con cua no:
duyethoiquy (childnode);
childnode := DBMS_XMLDOM.getnextsibling (childnode);
-------------------------------------
END LOOP;
ELSE -- is leaf
-- reset gia tri cua node duoc clone nay roi
DBMS_XMLDOM.setnodevalue (clonenode, '');
END IF;
END IF;
END;
BEGIN
var :=
xmltype('<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <worksheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main"
xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="x14ac"
xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac">
<sheetData>
<row r="1"><c r="A1" s="2" t="s"><v>0</v></c><c r="B1" s="2" t="s"><v>0</v></c></row>
<row r="3"><c r="A3" s="2" t="s"><v>1</v></c><c r="B3" s="2" t="s"><v>1</v></c></row>
</sheetData>
</worksheet>');
-- Create DOMDocument handle:
ndoc :=
DBMS_XMLDOM.makenode(DBMS_XMLDOM.getdocumentelement (
DBMS_XMLDOM.newdomdocument (var)));
newnode :=
DBMS_XMLDOM.makenode(DBMS_XMLDOM.getdocumentelement(DBMS_XMLDOM.newdomdocument(xmltype('<row r="2"><c r="A2" s="1" t="s"><v>0</v></c></row>'))));
-- ghi vao node
nodelist := DBMS_XSLPROCESSOR.selectnodes (ndoc, '/worksheet/sheetData');
IF NOT DBMS_XMLDOM.isnull (nodelist)
THEN
node := DBMS_XMLDOM.item (nodelist, 0);
childnode := DBMS_XMLDOM.getlastchild (node);
clonenode := DBMS_XMLDOM.clonenode (childnode, TRUE);
-- thay doi node cha
duyethoiquy (clonenode);
-- DBMS_XMLDOM.writetobuffer (newnode, buf);
-- DBMS_OUTPUT.put_line ('LastChild:' || buf);
elem :=
DBMS_XMLDOM.makeelement(DBMS_XMLDOM.appendchild (
node,
DBMS_XMLDOM.makenode(DBMS_XMLDOM.makeelement(DBMS_XMLDOM.importnode (
DBMS_XMLDOM.getownerdocument(node),
clonenode, --newnode,
TRUE)))));
END IF;
DBMS_XMLDOM.writetobuffer (ndoc, buf);
DBMS_OUTPUT.put_line ('After:' || buf);
END;
-- vi du voi xm;

Resources