I want to use the CRT unit in some Pascal code, just for the "clrscr" function but it's causing issues. The code compiles fine, but then some text is out of place and symbols appear where they shouldn't.
Here is the code:
program fuel(input, output);
var
i,vnumber:integer;
f,f2:text;
volfuel,dist,totalfuel,totaldist:double;
ch:char;
s,z:string;
begin
assign(f,'fuel.txt');
assign(f2,'report.txt');
{$i-}
reset(f);
rewrite(f2);
{$i+}
if ioresult<>0 then halt;
totalfuel:=0;
totaldist:=0;
s:='~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~';
writeln(s);
writeln(f2,s);
z:='Vehicle No.'+#9+'Fuel Consumption (MPG)';
writeln(z);
writeln(f2,z);
writeln(s);
writeln(f2,s);
while not eof(f) do
begin
read(f,vnumber);
read(f,ch);
read(f,volfuel);
read(f,ch);
read(f,dist);
readln(f);
totalfuel:=totalfuel+volfuel;
totaldist:=totaldist+dist;
writeln(vnumber,#9,(dist/volfuel):15:2);
writeln(f2,vnumber,#9,(dist/volfuel):15:2);
end;
writeln(s);
writeln(f2,s);
z:='~~~~~~~~~~~~~~~~~~~~SUMMARY~~~~~~~~~~~~~~~~~~~~~~~~';
writeln(z);
writeln(f2,z);
writeln(s);
writeln(f2,s);
writeln('Total Gallons = ',totalfuel:10:2);
writeln(f2,'Total Gallons = ',totalfuel:10:2);
writeln('Mean Petrol Consumption = ',totaldist/totalfuel:10:2);
writeln(f2,'Mean Petrol Consumption = ',totaldist/totalfuel:10:2);
close(f);
close(f2);
readln;
end.
As soon as I add "uses crt;" that's when I get problems. It's not just happened with this Pascal program either, I few I have done and then wanted to add "clrscr" or some colour, I can't as when I add CRT, it causes spacing/formatting problems.
Any help would be great!
If your OS is Windows, then it is probably the tab (#9) usage. Crt takes over I/O and might interpret them. But Crt on Windows should generally work fine. Detail your problems some more.
Related
When I create a textfile, next copy it to another directory and then try to delete the original, it won't work, because the programa keeps the file locked.
Before deleting the file, I set the file-attribute to 'normal'like this:
SetFileAttributes((pchar('C:\test')),FILE_ATTRIBUTE_NORMAL);
I cannot find any simple solution to resolve this.
I create the file like this:
bestand:= tstringlist.Create;
try
r:= FindFirst('test.*', faAnyFile, Res);
try
EOFound:= False;
if (r = 0) then
while not EOFound do
begin
bestand.Add(res.Name);
EOFound:= FindNext(Res) <> 0;
end;
finally
FindClose(Res);
end;
finally
bestand.SaveToFile('C:\test');
bestand.Free;
end;
The same problem occurs when only reading the file like this:
AssignFile(Txt,TmpBest);
Reset(Txt);
while not Eof(Txt) do
begin
Readln(Txt, s);
L.Items.add.caption:=s;
end;
CloseFile(Txt);
Later, I set the file attributes to 'Normal' and try to delete the file:
if CopyFile(pchar(file-org), pchar(file-dest), false) then
begin
SetFileAttributes(pchar(file-org),FILE_ATTRIBUTE_NORMAL);
if not DeleteFile(file-org) then
showmessage('delete ' + file-org + ' failed!');
where file-org is file Txt/TmpBest from the description above.
I must say: I am not a Delphi programmer; I write in COBOL, but 'inherited' this Delphi-program from a former collegue and need to add some changes to it.
I found the answer to my own question. I already mentioned that I am not a Delphi-programmer, so I did not notice another left-over statement from before my changes:
FSource := TFileStream.Create(SourceFile, fmOpenRead or fmShareDenyNone);
Removing that statement solved my problem; obviously that statement locked my file until close of the program. Thanks for your trying to help anyway.
In an attempt to recreate the getenvironment(..) C function of _winapi.c (direct link) in plain python using ctypes, I'm wondering how the following C code could be translated:
buffer = PyMem_NEW(Py_UCS4, totalsize);
if (! buffer) {
PyErr_NoMemory();
goto error;
}
p = buffer;
end = buffer + totalsize;
for (i = 0; i < envsize; i++) {
PyObject* key = PyList_GET_ITEM(keys, i);
PyObject* value = PyList_GET_ITEM(values, i);
if (!PyUnicode_AsUCS4(key, p, end - p, 0))
goto error;
p += PyUnicode_GET_LENGTH(key);
*p++ = '=';
if (!PyUnicode_AsUCS4(value, p, end - p, 0))
goto error;
p += PyUnicode_GET_LENGTH(value);
*p++ = '\0';
}
/* add trailing null byte */
*p++ = '\0';
It seems that the function ctypes.create_unicode_buffer(..) (doc, code) is doing something quite close that I could reproduce if only I could have an access to Py_UCS4 C type or be sure of its link to any other type accessible to python through ctypes.
Would c_wchar be a good candidate ?, but it seems I can't make that assumption, as python 2.7 could be compiled in UCS-2 if I'm right (source), and I guess windows is really waiting fo UCS-4 there... even if it seems that ctypes.wintypes.LPWSTR is an alias to c_wchart_p in cPython 2.7 (code).
For this question, it is safe to make the assumption that the target platform is python 2.7 on Windows if that helps.
Context (if it has some importance):
I'm in the process of delving for the first time in ctypes to attempt a plain python fix at cPython 2.7's bug hitting windows subprocess.Popen(..) implementation. This bug is a won't fix. This bug prevents the usage of unicode in command line calls (as executable name or arguments). This is fixed in python 3, so I'm having a go at reverse implementing in plain python the actual cPython3 implementation of the required CreateProcess(..) in _winapi.c which calls in turn getenvironment(..).
This possible workaround was mentionned in the comments of this answer to a question related to subprocess.Popen(..) unicode issues.
This doesn't answer the part in the title about build specifically UCS4 buffer. But it gives a partial answer to the question in bold and manage to create a unicode buffer that seems to work on my current python 2.7 on windows: (so maybe UCS4 is not required).
So we are here taking the assumption that c_wchar is what windows require (if it is UCS4 or UCS2 is not so clear to me yet, and it might have no importance, but I recon having a very light confidence in my knowledge here).
So here is the python code that reproduces the C code as requested in the question:
## creation of buffer of size totalsize
wenv = (c_wchar * totalsize)()
wenv.value = (unicode("").join([
unicode("%s=%s\0") % (key, value)
for k, v in env.items()])) + "\0"
This wenv can then be fed to CreateProcessW and this seems to work.
I'm trying to get total system memory using GlobalMemoryStatusEx():
MEMORYSTATUSEX memory;
GlobalMemoryStatusEx(&memory);
#define PRINT(v) {printf("%s ~%.3fGB\n", (#v), ((double)v)/(1024.*1024.*1024.));}
PRINT(memory.ullAvailPhys);
PRINT(memory.ullTotalPhys);
PRINT(memory.ullTotalVirtual);
PRINT(memory.ullAvailPageFile);
PRINT(memory.ullTotalPageFile);
#undef PRINT
fflush(stdout);
But the result is very weired and not understandable.
memory.ullAvailPhys ~1.002GB
memory.ullTotalPhys ~1.002GB
memory.ullTotalVirtual ~0.154GB
memory.ullAvailPageFile ~0.002GB
memory.ullTotalPageFile ~1.002GB
My total physical memory is 8GB but non of result is close it. All values are much smaller.
Also, the 'total' values keep changing whenever I execute. For instance, another result is here:
memory.ullAvailPhys ~0.979GB
memory.ullTotalPhys ~0.979GB
memory.ullTotalVirtual ~0.154GB
memory.ullAvailPageFile ~0.002GB
memory.ullTotalPageFile ~0.979GB
What am I doing wrong?
This is the part you are missing:
MEMORYSTATUSEX memory = { sizeof memory };
MSDN:
dwLength
The size of the structure, in bytes. You must set this member before calling GlobalMemoryStatusEx.
If you checked value returned by GlobalMemoryStatusEx, you could see the problem by getting error indication there.
I want to run two matlab scripts in parallel for a project and communicate between them. The purpose of this is to have one script do image analysis and sending the results to the other which will use it for more calculations (time consuming, but not related to the task of finding stuff in the images). Since both tasks are time consuming, and should preferably be done in real time, I believe that parallelization is necessary.
To get a feel for how this should be done I created a test script to find out how to communicate between the two scripts.
The first script takes a user input using the built in function input, and then using labSend sends it to the other, which recieves it, and prints it.
function [blarg] = inputStuff(blarg)
mpiInit(); %added because of error message, but do not work...
for i=1:2
labBarrier; % added because of error message
inp = input('Enter a number to write');
labSend(inp);
if (inp == 0)
break;
else
i = 1;
end
end
end
function [ blarg ] = testWrite( blarg )
mpiInit(); % added because of error message, but does not help
par = 0;
if ( blarg == 0)
par = 1;
end
for i = 1:10
if (par == 1)
labBarrier
delta = labReceive();
i = 1;
else
delta = input('Enter number to write');
end
if (delta == 0)
break;
end
s = strcat('This lab no', num2str(labindex), '. Delta is = ')
delta
end
end
%%This is the file test_parfor.m
funlist = {#inputStuff, #testWrite};
matlabpool(2);
mpiInit(); % added because of error message, but does not help
parfor i=1:2
funlist{i}(0);
end
matlabpool close;
Then, when the code is run, the following error message appears:
Starting matlabpool using the 'local' profile ... connected to 2 labs.
Error using parallel_function (line 589)
The MPI implementation has not yet been loaded. Please
call mpiInit.
Error stack:
testWrite.m at 11
Error in test_parfor (line 8)
parfor i=1:2
Calling the method mpiInit does not help... (Called as shown in the code above.)
And nowhere in the examples that mathworks have in the documentation, or on their website, show this error or what to do with it.
Any help is appreciated!
You would typically use constructs such as labSend, labRecieve and labBarrier within an spmd block, rather than a parfor block.
parfor is intended for implementing embarrassingly parallel algorithms, in other words algorithms that consist of multiple independent tasks that can be run in parallel, and do not require communication between tasks.
I'm stretching my knowledge here (perhaps someone more expert can correct me), but as I understand things, it does not set up an MPI ring for communication between workers, which is probably the explanation for the (rather uninformative) error message you're getting.
An spmd block enables communication between workers using labSend, labRecieve and labBarrier. There are quite a few examples of using them all in the documentation.
Sam is right that the MPI functionality is not enabled during parfor, only during spmd. You need to do something more like this:
spmd
funlist{labindex}(0);
end
(Sam is also quite right that the error message you saw is pretty unhelpful)
In Delphi you can create a standalone Windows VCL Forms application. You can also create a Windows service application.
Is it possible to combine the two in a single application that can run as a standalone application and can also be installed as a Windows service?
Totally possible. The trick is to edit the .dpr to create main form when you want to run as an application and the service form when you want to run as a service. Like this:
if SvComFindCommand('config') then begin
//When run with the /config switch, display the configuration dialog.
Forms.Application.Initialize;
Forms.Application.CreateForm(TfrmConfig, frmConfig);
Forms.Application.Run;
end
else begin
SvCom_NTService.Application.Initialize;
SvCom_NTService.Application.CreateForm(TscmServiceSvc, scmServiceSvc);
SvCom_NTService.Application.Run;
end;
The code above uses SvCom to run the service but exactly the same effect could be achieved using the standard TService.
I wrote an article about that for The Delphi Magazine many years ago. You can read it here: Many Faces Of An Application.
It'll be hard to explain but I will try :)
I've done it in my project like that (Delphi 5):
program TestSvc;
uses SvcMgr,
SvcMain, //the unit for TTestService inherited from TService
...
;
var
IsDesktopMode : Boolean;
function IsServiceRunning : Boolean;
var
Svc: Integer;
SvcMgr: Integer;
ServSt : TServiceStatus;
begin
Result := False;
SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
if SvcMgr = 0 then Exit;
try
Svc := OpenService(SvcMgr, 'TestService', SERVICE_QUERY_STATUS);
if Svc = 0 then Exit;
try
if not QueryServiceStatus(Svc, ServSt) then Exit;
Result := (ServSt.dwCurrentState = SERVICE_RUNNING) or (ServSt.dwCurrentState = SERVICE_START_PENDING);
finally
CloseServiceHandle(Svc);
end;
finally
CloseServiceHandle(SvcMgr);
end;
end;
begin
if (Win32Platform <> VER_PLATFORM_WIN32_NT) or FindCmdLineSwitch('S', ['-', '/'], True) then
IsDesktopMode := True
else begin
IsDesktopMode := not FindCmdLineSwitch('INSTALL', ['-', '/'], True) and
not FindCmdLineSwitch('UNINSTALL', ['-', '/'], True) and
not IsServiceRunning;
end;
if IsDesktopMode then begin //desktop mode
Forms.Application.Initialize;
Forms.Application.Title := 'App. Title';
ShowTrayIcon(Forms.Application.Icon.Handle, NIM_ADD); // This function for create an icon to tray. You can create a popupmenu for the Icon.
while GetMessage(Msg, 0, 0, 0) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
ShowTrayIcon(Forms.Application.Icon.Handle, NIM_DELETE); // for delete the tray Icon
end else begin // Service mode
SvcMgr.Application.Initialize;
SvcMgr.Application.CreateForm(TTestService, TestService);
SvcMgr.Application.Run;
end;
end.
Another almost simpler option is available at http://cc.embarcadero.com/item/19703, you just need to include a unit and change your DPR to something like:
begin
if CiaStartService('SERVICE NAME') then begin
CiaService.CreateForm(TMain, Main);
CiaService.Run;
Exit;
end;
Application.Initialize;
Application.Title := 'SERVICE NAME';
Application.CreateForm(TMain, Main);
Application.Run;
end.
While this example is now quite dated, the technique is simple enough that it still works, even with Delphi XE2. With this in place, your application will continue to operate as a non-service until you use the "/install" parameter (on an elevated command prompt). After which it will operate as a service until you use the "/uninstall" parameter (also on an elevated command prompt).
There is a solution for this problem without writing a single line of code. It depends a little on your application, but generally it is achievable. Try this: http://iain.cx/src/nssm. Don't forget to start all services that you application depends on BEFORE you start your application as a service. Google around for info on how to do that.
It is possible but in that case you cannot use the normal TServiceApplication and TService. You should implement all the service specific code yourself.
We had a similat problem and made two frame applications: one for the sand alone exe and one for the service. Now we can create a single BPL/DLL that is embedded in both containers.
If you want to spend some money: you should look at SvCOM, I think they have a solution to the problem.