Easy EXE attached data

Problem/Question/Abstract:

Using resources to include files into your EXE is a great thing, but I prefer using another way...

Answer:

When you compiled your code, and you want to attach 1 file to your file just use this command line:

COPY /B PROJECT1.EXE + DATA.TXT PROJECT2.EXE

A file, called Project2.Exe will be created and it will contain first file with 2nd file attached. That doesn't compromise EXE and it will be still working.

But: how to easly extract that file form the EXE?

First of all, you should use this function:

function GetAttachedData(MS: TMemoryStream): boolean;
var
  pMySelf: pChar;
  IdX, SectionsCount: integer;
  EXESize, EXEOriginalSize: cardinal;
  SR: TSearchRec;
  FS: TMemoryStream;
  EXEName: array[0..MAX_PATH] of char;
begin
  result := false;
  if MS = nil then
    exit;
  try
    MS.clear;
    // Gets EXE/DLL filename.
    fillchar(EXEName, sizeof(EXEName), #0);
    getmodulefilename(HInstance, EXEName, MAX_PATH);
    // Gets file size.
    EXESize := 0;
    if findfirst(EXEName, faAnyFile, SR) = 0 then
    begin
      EXESize := SR.size;
      sysutils.findclose(SR);
    end;
    // Gets originalsize.
    EXEOriginalSize := 0;
    try
      pMySelf := pointer(HInstance);
      if PImageDosHeader(pMySelf).E_Magic <> $00004550 then
        exit;
      inc(pMySelf, PImageDosHeader(pMySelf)._lfanew);
      if pDWord(pMySelf)^ <> $00004550 then
        exit;
      inc(pMySelf, sizeof(dword));
      SectionsCount := PImageFileHeader(pMySelf).NumberOfSections;
      inc(pMySelf, sizeof(TImageFileHeader) + sizeof(TImageOptionalHeader));
      for IdX := 1 to SectionsCount do
      begin
        with PImageSectionHeader(pMySelf)^ do
          if (PointerToRawData + SizeOfRawData) > EXEOriginalSize then
            EXEOriginalSize := PointerToRawData + SizeOfRawData;
        inc(pMySelf, sizeof(TImageSectionHeader));
      end;
    except
      on e: exception do
        EXEOriginalSize := 0;
    end;
    // If there's something attached...
    if EXESize > EXEOriginalSize then
    begin
      FS := TMemoryStream.create;
      try
        try
          // Read it...
          FS.loadfromfile(EXEName);
          FS.position := EXEOriginalSize;
          // and return it in the stream.
          MS.copyfrom(FS, EXESize - EXEOriginalSize);
          result := true;
        except
          on e: exception do
            result := false;
        end;
      finally
        FS.destroy;
      end;
    end;
  except
    on e: exception do
      result := false;
  end;
end;

Then, you can use it like this:

procedure TForm1.Button1Click(Sender: TObject);
var
  s: tmemorystream;
begin
  s := tmemorystream.create;
  try
    if GetAttachedData(s) then
      s.SaveToFile('output.txt');
  finally
    s.destroy;
  end;
end;

That's all. You don't need to use constants, resources or anything else.
Note that the code will work also if the EXE file is compressed with tools like UPX or similar.
Thanks to the site U.N.D.U. for some code snippets.

Are Cookies the Answer to Session Control?

Problem/Question/Abstract:

Are Cookies the Answer to Session Control?

Answer:

Managing state is an essential underpinning to mission-critical, browser-based applications. These programs need to behave as though they were running in a completely trusted environment. Users must be identifiable, and their actions must remain in context as far as the application is concerned. To do this, the programmer needs to focus on techniques for maintaining state.

The problem, of course, is that applications running in a Web environment are, by definition, stateless. Each time the CGI (Common Gateway Interface) or ISAPI (Internet Server Application Programming Interface) is called by the browser, it treats the call as a new request for information. Essentially "blind" to any previous requests this browser has made, the Web application may need to know certain details that help it determine how these requests are to be handled.

What Is Mission-critical?

The term mission-critical is subject to some amount of interpretation. Certainly, a college student hard-pressed to finish a term paper might consider his midnight Yahoo! searches to be mission-critical, but that sort of activity falls far short of the real definition. When designing Web applications for industrial and government use, the programmer can consider his project to be mission-critical when it meets any one of the following criteria:

The data being transmitted is strictly regulated by law or common practice, e.g. medical or legal information.
Unauthorized access to the application might present a risk of commercial or personal loss, either to the organization, the user, or any individual identified in the data stream.
Inability to access the application causes a work stoppage, corrupts data, or results in financial or personal harm of a grievous nature.

Essential to the definition is the concept of information vulnerability. Whether a reasonable person might expect data from the application to be used in a harmful or unlawful manner is immaterial. Mission-critical applications require a flexible approach to programming that often results in tightly coded, unique products.

Obviously, this is more expensive than off-the-shelf solutions. In part because of the cost factor, the same objection to tight coding is heard in every conference room and every office where Internet projects are planned: "Oh, nobody is really going to break in and steal our data!"

In fact, if US$500 can be made by stealing information from your system, you can go to sleep at night secure in the knowledge that someone, somewhere is working very hard to do just that. If drug-test results can be altered, it's worth somebody's time to attempt it. If children's court records can be opened, someone will make money finding a way to get at the information.

If your company makes its living producing mission-critical applications, a single failure with a single client can put you out of business. No amount of boardroom optimism will ever change that.

What Is Stateless?

Try to imagine a stateless session as a conversation between two individuals who can neither see nor hear the other. One of them remembers everything that has been said (the browser). The other one forgets everything that has been said (the server). The browser asks the server a question and receives a list of possible answers. It then refines the question, based upon the initial response, and asks for more information. Unfortunately, the server has now forgotten the original question.

Session Information

To keep up the "conversation" between server and browser, the browser must send specific information back to the server on each request. This information needs to be unique to each session, and needs to be reliable. It must be immune to guessing, getting lost, or being confused as something else.

The server application will probably want quite a bit of information about each browser request. This might include:

The age of the current session - No user should be allowed to remain logged in indefinitely. For example, some client locations may have only one browsing machine, and an indefinite session length would allow everybody to use the same session (violating standard security practices).
The amount of time since the last request - Users occasionally walk away from their workstations in the middle of a session. By limiting this time, the server can control most unwanted data disclosures.
User rights - The type of information a user could see might be spelled out in access permissions that can be transmitted as part of the session information.
The address of the browser using this session - While this might not always translate into a valid IP address, it can give important information regarding the physical location of the user.
The type of browser being used - Referring to this information can help the application determine whether to use JavaScript, how to code HTML, or even whether access is permitted at all.

Much more detail can be preserved, depending upon the specific needs of the Web application. Frequently, far more detail is needed than can be reliably transmitted with each page request.

Using Databases to Maintain State

No matter what method is used to pass session information between browser and server, the validity of that information needs to be checked against a database. Otherwise, the Web application will have no way of knowing whether the session information being transmitted is genuine.

The database can take any form, as long as it holds the session details in a persistent manner. Some ISAPI applications use an internal "database," made up of arrays or lists of objects describing each session. These are only semi-persistent, however, and all users may be forced to log in again if the application crashes or restarts.

Until Delphi 5 came along, ISAPI application developers frequently ran into problems interfacing with databases. As a result, many mission-critical applications ended up coded as CGI instead of ISAPI.

CGI applications are more stable, of course, but they exact a price. First, a separate copy of the CGI must be loaded every time a browser makes a request from the server. Although the cached copy of the CGI loads extremely quickly, the response can be delayed by over a second if it needs to make a database connection. Page production speed is an essential consideration in any Web application, but, since most pages are menus and instructions, there seems to be little reason to wait that additional second while the session information is verified.

Microsoft's Active Server Pages (ASP) use the global.asa database to store session variables about individual users, and use the Session object as a means to address these variables. However, if the client database uses InterBase, ASP has trouble coping. Until very recently, ODBC drivers for InterBase were not thread-safe, and had a history of refusing to perform certain operations, such as database inserts.

Session ID

The core piece of information used to maintain state is the session ID. This is a number or string that describes the session in a unique, secure, and reliable manner. It is essentially an index that can be used by the Web application to find specific session information stored in the database.

The session ID must be difficult to guess. If these numbers are issued sequentially or represent indexes into a small base of users, brute-force attacks on the Web application are easier. This usually means resorting to large, random numbers as the session ID.

The Delphi random number generator, however, is limited to 32-bit integers. One solution would be to combine two 32-bit numbers in a composite session ID. For instance, a composite 64-bit random number could be generated with the following code:

sSessionID := IntToHex(Random($FFFFFFFF), 8) + IntToHex(Random($FFFFFFFF), 8);

This example might produce a session ID looking something like "A23CF8F3." This session ID would be nearly impossible to guess.

Keeping the session ID unique is bit more involved. The larger the session ID is relative to the installed base of users, the less likely duplicates are to occur. Trusting fate, however, is not a wise strategy in mission-critical applications. If using a TStringList of session objects, the application can simply add the session ID to a string in the list. If the string is set to sort automatically, duplicate session IDs can be trapped by setting the TStringList.Duplicate property to dupError. If the application stores sessions in a database, then the SessionID field of the sessions table should be constrained to use unique values. This way, violations of this constraint can be trapped.

Remote Address Variable

But why generate a unique session ID at all? Why not just use the REMOTE_ADDR environmental variable? In Delphi, that variable is found in the TWebRequest.RemoteAddress object property. This returns the IP address assigned to each browser. Because these are unique by definition, they seem to be ideal candidates for use as session IDs.

However, the browser's IP address presents one major problem that severely limits its usefulness as a session identifier. Users working behind address-translating firewalls or application proxy servers may not be able to send their actual identity across to the Web application. This is a common problem when dialing in through an ISP. The user's IP address might be translated into something like "philmax1-p75.mississippi.net." Because the RemoteAddress property is unreliable in large systems, it should never be used as the session ID.

Whatever form the session ID takes, it needs to be sent between the browser and the Web server on every request. The method by which this information is sent deserves close inspection.

Session Information in Cookies

Cookies help track state information by recording essential data in small files maintained by the browser on the client's hard drive. ASP uses cookies as its principal means of passing session identification variables between the server and the browser. Cookies are equally simple to use in Delphi, although more knowledge of the underlying code is required. To send a cookie from a Delphi Web application is very simple, as shown in Figure 1.

procedure TWebModule1.WebModule1WebActionItem1Action(
  Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
  tslCookie: TStringList;
begin
  tslCookie := TStringList.Create;
  tslCookie.Add('USERID=JME');
  Response.SetCookieField(tslCookie, 'mydomain.com',
    '/scripts', Now, False);
  Response.Content := 'Cookie sent!';
  tslCookie.Free;
end;
Figure 1: Sending a cookie from a Delphi Web application.

This sends a cookie to the browser along with the response stream. Whenever the browser requests information from a Web application located in the http://mydomain.com/scripts directory, this cookie - if it's on the hard drive - will be sent to the server as part of the request stream. The operative phrase is "if it's on the hard drive." The third parameter in the SetCookieField method contains the value "Now." You might interpret this to mean that the cookie expires immediately, but it's not that easy. "Now," in cookie terms, may not actually be now.

As an experiment, set up Netscape to prompt you before accepting a cookie. Then write a test CGI in Delphi that sends a cookie set to expire at "Now." Finally, save your program in a scripts directory on your workstation (running PWS or IIS), and load the CGI. If your workstation is running under Central Daylight Savings Time (this is GMT [Greenwich Mean Time] minus six hours), you'll be told that the cookie expired nearly thirty years ago!

The problem is that the cookie always assumes that the server was running under GMT. Once on your browser, the cookie does some math. It figures out what the GMT time is relative to your local time, and then sets itself up to expire then. If your server was set up under Central Daylight Savings Time, the cookie is actually running a little late - about six hours worth.

It takes a little work, but once you have a firm handle on how to set up the cookie expiration date, you can explicitly limit the session time by limiting the lifespan of the cookie. Your CGI only needs to read the contents of the cookie, and if there are none, force the user to login again. Reading a cookie is far easier than sending one, for example:

procedure TWebModule1.WebModule1WebActionItem2Action(
  Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := '<html><body><h1>COOKIE TEST</h1><hr>'
    + 'USER ID = ' + Request.CookieFields.Values['USERID']
    + '</body></html>';
end;

Some cookies never get stored on the browser's hard drive. These are known as "session cookies" because they only stay alive as long as the browser is on. To set up a session cookie, the expiration date needs to be omitted from the cookie. In Delphi, this is done by setting the date string to "-1" instead of "Now". Cookies of this type can be used to help determine if a user has shut down their browser.

If more information needs to be exchanged between the browser and the server, the TStringList object used to set the cookie should have additional Name=Value pairs added to it. Other than that, the code in the TWebResponse.SetCookieField method is the same. The overall effect, however, is quite different.

Drawbacks to Using Cookies

For each Name=Value pair sent to the SetCookieField method, an additional cookie is sent in the response stream. More cookies are sent as the session data set becomes more complex. This can eventually overrun the maximum cookie limit for a domain (20 cookies), with serious consequences. The oldest cookie from that domain will be dropped. Unfortunately, if all the cookies have the same date, they could all be dropped. In a best-case scenario, some session information will be lost. At worst, the cookies won't work at all, and might even crash the browser.

One way to get around the 20-cookie domain limit is to send all the session information as a single string, delimited somehow. Separating fields with a special character (& for instance) will allow you to cram more information into a single cookie. There are only two limitations to this technique. One, you can't have more than a single "=" (equal) sign anywhere in the string. Otherwise, the SetCookieField method will split the information into two cookies. And two, there is a size limit to cookies; they cannot exceed 4,096 characters. If your session information includes complex SQL strings, for instance, you can end up with an invalid cookie.

There are other problems with cookies that deserve a closer look. To function, cookies depend upon path specificity. Cookies are sent back to the server if the browser's URL matches the domain/path specified in the cookie. A cookie set to respond to "/scripts/AnyCGI.Exe", for example, couldn't be redirected to "/scripts/PassChange.Exe". To allow redirection, the path specification in this example would have to be changed to "/scripts/". Unfortunately, that cookie would also be sent to "/scripts/LaundryList.Exe", and might overwrite information from properly authorized cookies.

Cookies are vulnerable to a more insidious problem as well: They can be spoofed. Programmers can use the "domain override bug" to set up a cookie domain field of "anywhere.com..." . When users holding this cookie hit the site at "nowhere.com.../scripts/Test," the cookie is sent. This gets around the domain privacy model inherent in cookies, and is a function of the browser being used. Internet Explorer doesn't store this cookie in a persistent state, running it instead as a session cookie. Netscape runs the cookie normally.

The domain override bug only affects cookies carrying domain names, not IP numbers. And its use as a hacking tool is highly questionable. Nevertheless, because of well-publicized, and often misinterpreted flaws in cookie design, many organizations have installed firewalls and proxy servers that have the ability to strip cookies from the response stream.

If your Web application requires cookies, its design may require clients to change their organizational MIS policies before they can use your program. How difficult can this be? Until recently, AOL users couldn't receive cookies at all. The doctrine of requiring cookies in mission-critical applications, therefore, may provide an insurmountable marketing challenge. The negative impact on the developer's long-term income should deter such an approach.

Managing State with Forms

Before there were cookies, there were "Hidden" fields. These do not show up in your browser forms, but are passed along with server requests anyway. There are two ways to send form information back to the Web server: use the Get and Post methods.

The Get method takes the Name=Value pairs from each form input field and appends them to the URL. They're then passed into the Web application in the QUERY_STRING environmental variable. In Delphi, Get variables are passed through the TWebRequest.Query object. One principal disadvantage of using the Get method is that the query string is displayed in the browser's address window. Even passwords, normally protected from eavesdropping by hiding them in "password-type" fields, are plainly visible if sent with the Get method.

The Post method sends the information in a separate data stream, which the Delphi Web application reads through the TWebRequest.Content object. The following HTML lines, for example, will send the form information to the server using the Post method:

<Form Action="/scripts/AnyCGI.Exe" Method="Post">
  <Input Type="HIDDEN" Name="UserID" Value="JME">
</Form>

The Web application will decode this form as Request.ContentFields.Values['UserID']='JME'. It's just as easy to deal with on the receiving side as information in a cookie, but requires considerably more planning to set up. Some programmers consider hidden fields less secure than cookies because the View Source browser command lets users see what information is stored there.

Being able to see the contents of hidden fields is not a serious drawback, however. The only information that should be absolutely required would be the unique session ID. Anything else needed to track this session should be stored in a persistent database on the Web server.

Using URL Variables

One major benefit of using the Get method is the fact that the QUERY_STRING variable can be set without using a form at all. Web applications can append information of almost any type to the end of the URL. This technique can be used to pass session-tracking information between Web applications, or even between Web servers.

Here's what that paragraph means in practice. Suppose you have an application that presents the user with a list of options, one of which is "Change Password." Your password modification program, however, is in a separate CGI. What your code needs to do is forward the request to the new program, using the following Delphi code:

with Request.ContentFields do
  if Values['Action'] = 'Change Password' then
    Request.SendRedirect('/scripts/NewPassword.Exe');

The trouble is that this code sample won't work. Information passed with the Post method can't be redirected (a limitation of the HTTP specification). The entire TWebRequest.Content object will be discarded. Of course, you could recode all your Delphi Web applications to use the Get method, but it's a lot easier to simply append the session ID to the redirection request:

with Request.ContentFields do
  if Values['Action'] = 'Change Password' then
    Request.SendRedirect('/scripts/NewPassword.Exe?' +
      Values['SessionID']);

The new application can then look at the value of the TWebRequest.Query property. It will contain a single number: the session ID.

There are limitations associated with appending data to the URL, regardless of whether you put it there in the code or use the Get method. The most serious of these is the fact that you can send a maximum of only 255 characters. Send more, and the browser could crash. This is one of the major reasons to avoid using the Get method to maintain state in applications that pass a lot of SQL strings between multiple pages. It's far more reliable to store your session variables in a database, and simply pass the session ID.

This technique removes the limitation requiring you to always send information in a form. By appending the session ID to the URL, your Web pages can maintain state inside links, as well. For example, to link to a special CGI, your HTML code might look like this:

<A HREF="/scripts/NewCGI.exe?FF2B87A3>

In this example, the session ID, "FF2B87A3", is sent as the only variable in the query string. The Web application seeing this in the TWebRequest.Query property would typically check to see whether a session exists for this ID, and would either continue processing, or halt (if the session ID didn't match).

Sending Information with JavaScript

Java applets, ActiveX controls, and cookies can all be blocked with appropriate firewall or proxy server applications. This is because any element that exists outside of the HTML document itself can be stripped away before the browser ever sees it. JavaScript, on the other hand, only exists inside the HTML document. It always gets delivered to the browser.

Of course, individual users could set their browsers to reject JavaScript. This is less of a problem than firewall-level blocking, as the programmer doesn't have to contend with organizational policies in order to make the product function. Just to be on the safe side, however, mission-critical applications should avoid the use of JavaScript in essential functions (such as form submission buttons) wherever possible. Always have a backup method to submit forms.

Conclusion

There are problems that programmers can control, and some they can't. They can control the amount of information exchanged in session tracking. They can control the method of transfer. They can control the storage medium for session details.

The amount of data sent between the browser and Web server should be kept to a minimum. The session information exchange should normally consist of a unique, secure identifier, and nothing else. Everything the application needs to know about the session should be retrieved from storage.

Data sent between the browser and the Web server should be as invisible as possible, but needs to match the intent of the data. For instance, password forms should never use the form Get method, because the password and user ID will eventually end up in the browser history for anyone to see. The session ID can be sent openly without fear of spoofing if it's properly designed. Forms, JavaScript, and URL appending can all be useful transfer methods, as long as their individual limitations are understood.

The session information storage medium needs to be fast and robust. Keeping session information in a list of objects on the DLL is fast and easy, but suffers from volatility. The contents of this list should be committed to an actual database before shutting down the Web server, or all your users will have to log in again.

There will always be problems programmers can't control. Database drivers can interfere with one another, or with the correct functioning of the application. Web site design requirements may require a frames-based approach to forms. Client functional requirements might dictate the need to code exclusively in CGI, or to support outdated browsers.

Perhaps the most restrictive problems involve organizational policies that limit user access across the Internet. These doctrines may require firewall and proxy filters that exclude cookies, ActiveX, and Java applets. Unless the programmer has absolute authority over every aspect of user connectivity, filters such as these must be assumed to be in place somewhere. For that reason alone, cookies should never be the exclusive session-tracking method in any mission-critical application.

Setting NTFS File/Folder Security

Problem/Question/Abstract:

I saw an article that helps setting NTFS security on file or folder. There are many problems with different NTFS (NT4, NT2000, XP) especially with inheritance. The code I am posting is too long, but works fine.

Answer:

Some constants and type definitions are copied from JCL, some from Microsoft C++ headers, but unit doesn't need of any additional code to be compiled. Try it on your own risk. There are additional functions that can help: IsNT, IsNT4, IsAdmin, etc. Some constants are not used.

unit NTSecurityU;

interface
uses Windows, AclApi, AccCtrl;

const

SECURITY_NULL_SID_AUTHORITY: _SID_IDENTIFIER_AUTHORITY = (Value: (0, 0, 0, 0, 0,
0));
SECURITY_WORLD_SID_AUTHORITY: _SID_IDENTIFIER_AUTHORITY = (Value: (0, 0, 0, 0, 0,
1));
SECURITY_LOCAL_SID_AUTHORITY: _SID_IDENTIFIER_AUTHORITY = (Value: (0, 0, 0, 0, 0,
2));
SECURITY_CREATOR_SID_AUTHORITY: _SID_IDENTIFIER_AUTHORITY = (Value: (0, 0, 0, 0, 0,
3));
SECURITY_NON_UNIQUE_AUTHORITY: _SID_IDENTIFIER_AUTHORITY = (Value: (0, 0, 0, 0, 0,
4));
SECURITY_NT_AUTHORITY: _SID_IDENTIFIER_AUTHORITY = (Value: (0, 0, 0, 0, 0, 5));

SECURITY_WORLD_RID: CARDINAL = $00000000;
SECURITY_BUILTIN_DOMAIN_RID: CARDINAL = $00000020;
DOMAIN_ALIAS_RID_ADMINS: CARDINAL = $00000220;
DOMAIN_ALIAS_RID_USERS: CARDINAL = $00000221;
DOMAIN_ALIAS_RID_GUESTS: CARDINAL = $00000222;

STANDARD_RIGHTS_ALL: CARDINAL = $001F0000;
ACL_REVISION: CARDINAL = 2; // current revision;

const
ACCESS_MIN_MS_ACE_TYPE = ($0);
{$EXTERNALSYM ACCESS_MIN_MS_ACE_TYPE}
ACCESS_ALLOWED_ACE_TYPE = ($0);
{$EXTERNALSYM ACCESS_ALLOWED_ACE_TYPE}
ACCESS_DENIED_ACE_TYPE = ($1);
{$EXTERNALSYM ACCESS_DENIED_ACE_TYPE}
SYSTEM_AUDIT_ACE_TYPE = ($2);
{$EXTERNALSYM SYSTEM_AUDIT_ACE_TYPE}
SYSTEM_ALARM_ACE_TYPE = ($3);
{$EXTERNALSYM SYSTEM_ALARM_ACE_TYPE}
ACCESS_MAX_MS_V2_ACE_TYPE = ($3);
{$EXTERNALSYM ACCESS_MAX_MS_V2_ACE_TYPE}

ACCESS_ALLOWED_COMPOUND_ACE_TYPE = ($4);
{$EXTERNALSYM ACCESS_ALLOWED_COMPOUND_ACE_TYPE}
ACCESS_MAX_MS_V3_ACE_TYPE = ($4);
{$EXTERNALSYM ACCESS_MAX_MS_V3_ACE_TYPE}

ACCESS_MIN_MS_OBJECT_ACE_TYPE = ($5);
{$EXTERNALSYM ACCESS_MIN_MS_OBJECT_ACE_TYPE}
ACCESS_ALLOWED_OBJECT_ACE_TYPE = ($5);
{$EXTERNALSYM ACCESS_ALLOWED_OBJECT_ACE_TYPE}
ACCESS_DENIED_OBJECT_ACE_TYPE = ($6);
{$EXTERNALSYM ACCESS_DENIED_OBJECT_ACE_TYPE}
SYSTEM_AUDIT_OBJECT_ACE_TYPE = ($7);
{$EXTERNALSYM SYSTEM_AUDIT_OBJECT_ACE_TYPE}
SYSTEM_ALARM_OBJECT_ACE_TYPE = ($8);
{$EXTERNALSYM SYSTEM_ALARM_OBJECT_ACE_TYPE}
ACCESS_MAX_MS_OBJECT_ACE_TYPE = ($8);
{$EXTERNALSYM ACCESS_MAX_MS_OBJECT_ACE_TYPE}

ACCESS_MAX_MS_V4_ACE_TYPE = ($8);
{$EXTERNALSYM ACCESS_MAX_MS_V4_ACE_TYPE}
ACCESS_MAX_MS_ACE_TYPE = ($8);
{$EXTERNALSYM ACCESS_MAX_MS_ACE_TYPE}

ACCESS_ALLOWED_CALLBACK_ACE_TYPE = $9;
{$EXTERNALSYM ACCESS_ALLOWED_CALLBACK_ACE_TYPE}
ACCESS_DENIED_CALLBACK_ACE_TYPE = $A;
{$EXTERNALSYM ACCESS_DENIED_CALLBACK_ACE_TYPE}
ACCESS_ALLOWED_CALLBACK_OBJECT_ACE_TYPE = $B;
{$EXTERNALSYM ACCESS_ALLOWED_CALLBACK_OBJECT_ACE_TYPE}
ACCESS_DENIED_CALLBACK_OBJECT_ACE_TYPE = $C;
{$EXTERNALSYM ACCESS_DENIED_CALLBACK_OBJECT_ACE_TYPE}
SYSTEM_AUDIT_CALLBACK_ACE_TYPE = $D;
{$EXTERNALSYM SYSTEM_AUDIT_CALLBACK_ACE_TYPE}
SYSTEM_ALARM_CALLBACK_ACE_TYPE = $E;
{$EXTERNALSYM SYSTEM_ALARM_CALLBACK_ACE_TYPE}
SYSTEM_AUDIT_CALLBACK_OBJECT_ACE_TYPE = $F;
{$EXTERNALSYM SYSTEM_AUDIT_CALLBACK_OBJECT_ACE_TYPE}
SYSTEM_ALARM_CALLBACK_OBJECT_ACE_TYPE = $10;
{$EXTERNALSYM SYSTEM_ALARM_CALLBACK_OBJECT_ACE_TYPE}

ACCESS_MAX_MS_V5_ACE_TYPE = $10;
{$EXTERNALSYM ACCESS_MAX_MS_V5_ACE_TYPE}

SUCCESSFUL_ACCESS_ACE_FLAG = ($40);
{$EXTERNALSYM SUCCESSFUL_ACCESS_ACE_FLAG}
FAILED_ACCESS_ACE_FLAG = ($80);
{$EXTERNALSYM FAILED_ACCESS_ACE_FLAG}

type

PACE_HEADER = ^ACE_HEADER;
_ACE_HEADER = record
AceType: Byte;
AceFlags: Byte;
AceSize: Word;
end;

ACE_HEADER = _ACE_HEADER;

TAceHeader = ACE_HEADER;
PAceHeader = PACE_HEADER;

//Access Allowed ACE
PAccessAllowedAce = ^TAccessAllowedAce;
_ACCESS_ALLOWED_ACE = record
Header: ACE_HEADER;
Mask: DWORD;
SidStart: DWORD;
end;
TAccessAllowedAce = _ACCESS_ALLOWED_ACE;

type
//=== ACL (Access Control List)==============================
//Size information
PACL_SIZE_INFORMATION = ^ACL_SIZE_INFORMATION;
_ACL_SIZE_INFORMATION = record
AceCount,
AclBytesInUse,
AclBytesFree: DWORD
end;
ACL_SIZE_INFORMATION = _ACL_SIZE_INFORMATION;
TAclSizeInformation = ACL_SIZE_INFORMATION;
PAclSizeInformation = PACL_SIZE_INFORMATION;

//Revision Information
PACL_REVISION_INFORMATION = ^ACL_REVISION_INFORMATION;
_ACL_REVISION_INFORMATION = record
AclRevision: DWORD
end;
ACL_REVISION_INFORMATION = _ACL_REVISION_INFORMATION;
TAclRevisionInformation = ACL_REVISION_INFORMATION;
PAclRevisionInformation = PACL_REVISION_INFORMATION;

function IsAdmin: Boolean; stdcall; //is logged user is member of admins or
//domain admins
function IsNT: Boolean; stdcall; //is system NT based
function IsNT4: Boolean; stdcall; //is system NT 4
function GetEveryOneSid: Pointer; stdcall; //Security identifier of well known
// group Everyone
function GetAccountSID(anAccountName: string): Pointer; stdcall;

function SetFileObjectAccessRights(aFileObject: string;
aSID: Pointer; anAccess: CARDINAL; isInheritedAccess: BOOLEAN): BOOLEAN; stdcall;

function SetFileObjectAndSubobjectsAccessRights(aFileObject: string;
aSID: Pointer; anAccess: CARDINAL): BOOLEAN; stdcall;

function SetEveryoneRWEDAccessToFileOrFolder(aFileOrFolder: string): BOOLEAN; stdcall;
function SetEveryoneRWEDAccessToFileOrFolderAndSubobjects(aFileOrFolder: string):
BOOLEAN; stdcall;

function VolumeSupportsPersistentACLs(aPath: string): Boolean; stdcall;

implementation
uses
SysUtils, ComObj;

function VolumeSupportsPersistentACLs(aPath: string): Boolean;
var
maxClen,
driveFlags: Cardinal;
i: Integer;
VolName, FSysName: array[0..MAX_PATH] of Char;
begin
aPath := ExtractFileDrive(aPath) + '\';
Result := FALSE;
if GetVolumeInformation(
PChar(aPath),
VolName,
SizeOf(VolName),
nil,
maxClen,
driveFlags,
FsysName,
SizeOf(FsysName)
) then
Result := driveFlags and FS_PERSISTENT_ACLS = FS_PERSISTENT_ACLS;
end;

function CheckCARDINALRslt(aCardinal: DWORD): Boolean;
begin
Result := aCardinal = ERROR_SUCCESS;
if not Result then
SetLastError(aCardinal);
end;

function IsAdmin: Boolean;
var
ntauth: SID_IDENTIFIER_AUTHORITY;
psidAdmin: Pointer;
bIsAdmin: Boolean;
htok: THandle;
cb: DWORD;
ptg: ^TOKEN_GROUPS;
i: Integer;
grp: PSIDAndAttributes;
begin
Result := FALSE;
if not IsNT then
Result := TRUE
else
begin
bIsAdmin := FALSE;
ntauth := SECURITY_NT_AUTHORITY;
psidAdmin := nil;
AllocateAndInitializeSid(
ntauth, 2,
SECURITY_BUILTIN_DOMAIN_RID,
DOMAIN_ALIAS_RID_ADMINS,
0, 0, 0, 0, 0, 0, psidAdmin
);

htok := 0;
OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, htok);
GetTokenInformation(htok, TokenGroups, nil, 0, cb);
GetMem(ptg, cb);
GetTokenInformation(htok, TokenGroups, ptg, cb, cb);

grp := @(ptg.Groups[0]);

for i := 0 to ptg.GroupCount - 1 do
begin
if EqualSid(psidAdmin, grp.Sid) then
begin
bIsAdmin := TRUE;
Break;
end;
Inc(grp); //, SizeOf( TSIDAndAttributes));
end;
freemem(ptg);
CloseHandle(htok);
FreeSid(psidAdmin);
Result := bIsAdmin;
end; // else of : if not IsNT
end;

function IsNT: Boolean;
var
ovi: TOSVersionInfo;
begin
FillChar(ovi, SizeOf(Ovi), 0);
ovi.dwOSVersionInfoSize := SizeOf(Ovi);
GetVersionEx(ovi);
Result := ovi.dwPlatformId = VER_PLATFORM_WIN32_NT;
end;

function IsNT4: Boolean;
var
ovi: TOSVersionInfo;
begin
FillChar(ovi, SizeOf(Ovi), 0);
ovi.dwOSVersionInfoSize := SizeOf(Ovi);
GetVersionEx(ovi);
Result := (ovi.dwPlatformId = VER_PLATFORM_WIN32_NT) and (ovi.dwMajorVersion = 4);
end;

function GetEveryOneSid: Pointer;
begin
AllocateAndInitializeSid(
SECURITY_WORLD_SID_AUTHORITY,
1,
SECURITY_WORLD_RID,
0,
0, 0, 0, 0, 0, 0,
Result
);
end;

function GetAccountSID(anAccountName: string): Pointer;
var
cb: CARDINAL;
refDomainName: array[0..1024] of Char;
cbRefDomainName: Cardinal;
peUse: Cardinal;
SD: Pointer;
begin
SD := nil;
try
cbRefDomainName := SizeOf(refDomainName);
FillChar(refDomainName, cbRefDomainName, 0);
cb := 0;
LookupAccountName(nil, PChar(anAccountName), nil, cb, refDomainName,
cbRefDomainName, peUse);
if cb > 0 then
begin
GetMem(SD, cb);
FillChar(SD^, cb, 0);
if not LookupAccountName(nil, PChar(anAccountName), SD, cb, refDomainName,
cbRefDomainName, peUse) then
begin
FreeMem(SD, cb);
SD := nil;
end;
end
else
begin
SD := nil;
end;
finally
Result := SD;
end;
end;

function SetFileObjectAndSubobjectsAccessRights(aFileObject: string;
aSID: Pointer; anAccess: CARDINAL): BOOLEAN;
function RecursiveSet(aPath: string): Boolean;
var
F: TSearchRec;
i: Integer;
begin
Result := SetFileObjectAccessRights(aPath, aSID, anAccess, TRUE);
i := FindFirst(aPath + '\*.*', faAnyFile, F);
try
while i = 0 do
begin
if (F.Name <> '') and (F.Name[1] <> '.') then
begin
if F.Attr and faDirectory = faDirectory then
Result := Result and RecursiveSet(aPath + '\' + F.Name)
else
Result := Result and SetFileObjectAccessRights(aPath + '\' + F.Name, aSID,
anAccess, TRUE);
if not Result then
Exit;
end;
i := FindNext(F);
end;
finally
FindClose(F);
end;
end;

begin
Result := FALSE;
aFileObject := TRIM(aFileObject);
if aFileObject <> '' then
begin
if DirectoryExists(aFileObject) then
begin
if aFileObject[Length(aFileObject)] = '\' then
Delete(aFileObject, Length(aFileObject), 1);
Result := RecursiveSet(aFileObject);
Result := Result and SetFileObjectAccessRights(aFileObject, aSID, anAccess,
FALSE);
end
else
Result := SetFileObjectAccessRights(aFileObject, aSID, anAccess, FALSE);
end;
end;

function SetEveryoneRWEDAccessToFileOrFolder(aFileOrFolder: string): BOOLEAN;
var
SID: Pointer;
begin
Result := FALSE;
AllocateAndInitializeSid(
SECURITY_WORLD_SID_AUTHORITY,
1,
SECURITY_WORLD_RID,
0,
0, 0, 0, 0, 0, 0,
SID
);
if IsValidSid(SID) then
try
Result := SetFileObjectAccessRights(aFileOrFolder,
SID,
GENERIC_READ + GENERIC_WRITE + GENERIC_EXECUTE + _DELETE,
FALSE
);
finally
FreeSid(SID);
end;
end;

function SetEveryoneRWEDAccessToFileOrFolderAndSubobjects(aFileOrFolder: string):
BOOLEAN;
var
SID: Pointer;
begin
SID := GetEveryOneSid;
try
Result := SetFileObjectAndSubobjectsAccessRights(aFileOrFolder,
SID,
GENERIC_READ + GENERIC_WRITE + GENERIC_EXECUTE + _DELETE
);
finally
FreeSid(SID);
end;
end;

function SetFileObjectAccessRights(aFileObject: string;
aSID: Pointer; anAccess: CARDINAL; isInheritedAccess: BOOLEAN): BOOLEAN;
var
PPACL, PPACL2: PACL;
newDacl: PACL;
SecDescPtr, SD2: PSECURITY_DESCRIPTOR;
needed: Cardinal;
SD_Control: WORD;
SD_Revision: Cardinal;
aTrustee: TRUSTEE;
expAccess: PExplicit_Access;
isFile: Boolean;
CurACEBr, CurACEInd: CARDINAL;
OldAclSI: TAclSizeInformation;
OldAclRI: TAclRevisionInformation;
anACE: PAccessAllowedAce;
i: Integer;
oldACLSize, newACLSize, newACESize: Cardinal;
bPresent, bDefaulted: LongBool;
begin
Result := false;
if not IsValidSid(aSID) then
Exit;

isFile := FileExists(aFileObject);

PPACL := nil;
if not IsNT4 then
begin
if not CheckCardinalRslt(
GetNamedSecurityInfo(PChar(aFileObject), SE_FILE_OBJECT,
DACL_SECURITY_INFORMATION, nil, nil, PACL(@PPACL), nil, SecDescPtr)
) then
Exit;
end
else
begin
GetFileSecurity(PChar(aFileObject), DACL_SECURITY_INFORMATION, nil, 0, needed);
GetMem(SecDescPtr, needed);
FillChar(SecDescPtr^, needed, 0);
if not GetFileSecurity(PChar(aFileObject), DACL_SECURITY_INFORMATION, SecDescPtr,
needed, needed) then
Exit;
if not GetSecurityDescriptorDacl(SecDescPtr, bPresent, PPACL, bDefaulted) then
Exit;
end;
try
if not Assigned(PPACL) then
Exit;
if not GetSecurityDescriptorControl(SecDescPtr, SD_Control, SD_Revision) then
Exit;
if SD_Control and SE_DACL_PRESENT <> SE_DACL_PRESENT then
Exit;

if not GetAclInformation(PPACL^, @oldAclSI, SizeOF(TAclSizeInformation),
AclSizeInformation) then
Exit;
if not GetAclInformation(PPACL^, @oldAclRI, SizeOf(TAclRevisionInformation),
AclRevisionInformation) then
Exit;

//Delete previous ACE, for a given aSID
CurACEBr := oldAclSI.AceCount;
for i := oldAclSI.AceCount - 1 downto 0 do
begin
if GetAce(PPACL^, i, Pointer(anAce)) then
begin
if EqualSID(@(anACE.SidStart), aSID) then
begin
DeleteAce(PPACL^, i);
CurACEBr := CurACEBr - 1;
end;
end;
end;

if not GetAclInformation(PPACL^, @oldAclSI, SizeOF(TAclSizeInformation),
AclSizeInformation) then
Exit;
if not GetAclInformation(PPACL^, @oldAclRI, SizeOf(TAclRevisionInformation),
AclRevisionInformation) then
Exit;

NewACESize := SizeOf(TAccessAllowedACE) + GetLengthSid(aSID) - SizeOf(DWORD);
OldACLSize := oldAclSI.AclBytesInUse + oldAclSI.AclBytesFree;
NewACLSize := oldAclSI.AclBytesInUse + NewAceSize * 2 - oldAclSI.AclBytesFree;

if NewAclSize < OldAclSize then
NewAclSize := OldAclSize;

GetMem(PPACL2, NewACLSize);
try
FillChar(PPACL2^, NewACLSize, 0);

Move(PPACL^, PPACL2^, oldACLSize);
PPACL2.AclSize := newACLSize;

if not GetAclInformation(PPACL2^, @oldAclSI, SizeOF(TAclSizeInformation),
AclSizeInformation) then
Exit;

CurACEInd := 0;

if not IsNT4 then
begin
//Construct Our Ace
GetMem(anACE, newACESize);
try
FillChar(anACE^, newACESize, 0);
anACE.Header.AceType := ACCESS_ALLOWED_ACE_TYPE;

if not isFile then //demek e folder
begin
anACE.Header.AceFlags := SUB_CONTAINERS_ONLY_INHERIT +
SUB_OBJECTS_ONLY_INHERIT;
end;
if isInheritedAccess then
begin
if not IsNt4 then
anACE.Header.AceFlags := anACE.Header.AceFlags + INHERITED_ACCESS_ENTRY;
end;

anACE.Header.AceSize := newACESize;
anAce.Mask := anAccess;
Move(aSID^, anAce.SidStart, GetLengthSid(aSID));

if not AddAce(PPACL2^, OldAclRI.AclRevision, CurACEInd, anACE, newACESize)
then
Exit;
finally
FreeMem(anACE, newACESize);
end;
end
else
begin
CurACEInd := 0;
if not isFile then
begin
GetMem(anACE, newACESize);
try
FillChar(anACE^, newACESize, 0);
anACE.Header.AceType := ACCESS_ALLOWED_ACE_TYPE;

anACE.Header.AceFlags := SUB_CONTAINERS_ONLY_INHERIT +
SUB_OBJECTS_ONLY_INHERIT + INHERIT_ONLY;

anACE.Header.AceSize := newACESize;
anAce.Mask := anAccess;
Move(aSID^, anAce.SidStart, GetLengthSid(aSID));

if not AddAce(PPACL2^, OldAclRI.AclRevision, CurACEInd, anACE, newACESize)
then
Exit;
finally
FreeMem(anACE, newACESize);
end;
end;

//Add ACE for Files
GetMem(anACE, newACESize);
try
FillChar(anACE^, newACESize, 0);
anACE.Header.AceType := ACCESS_ALLOWED_ACE_TYPE;

anACE.Header.AceFlags := 0; // Empty flags, but ACE
anACE.Header.AceSize := newACESize;
anAce.Mask := anAccess;
Move(aSID^, anAce.SidStart, GetLengthSid(aSID));

if not AddAce(PPACL2^, OldAclRI.AclRevision, CurACEInd, anACE, newACESize)
then
Exit;
finally
FreeMem(anACE, newACESize);
end;
end;

if not GetAclInformation(PPACL2^, @oldAclSI, SizeOF(TAclSizeInformation),
AclSizeInformation) then
Exit;

if not IsNT4 then
begin
Result := CheckCARDINALRslt(
SetNamedSecurityInfo(PChar(aFileObject), SE_FILE_OBJECT,
DACL_SECURITY_INFORMATION, nil, nil, PPACL2, nil)
);
end
else
begin
GetMem(SD2, SizeOf(TSecurityDescriptor));
try
if not InitializeSecurityDescriptor(SD2, SECURITY_DESCRIPTOR_REVISION) then
Exit;
if not SetSecurityDescriptorDacl(SD2, bPresent, PPACL2, bDefaulted) then
Exit;
Result := SetFileSecurity(PChar(aFileObject), DACL_SECURITY_INFORMATION,
SD2);
finally
FreeMem(SD2, SizeOf(TSecurityDescriptor));
end;
end;
finally
FreeMem(PPACL2, NewACLSize);
end;
finally
LocalFree(HLOCAL(SecDescPtr));
end;
end;

end.

Get the HTML Code out of all Internet Explorer Instances

Problem/Question/Abstract:

Get the HTML Code out of all Internet Explorer Instances?

Answer:

uses
MSHTML_TLB, ActiveX;

function GetHTMLCode(WB: IWebbrowser2; ACode: TStrings): Boolean;
var
ps: IPersistStreamInit;
s: string;
ss: TStringStream;
sa: IStream;
begin
ps := WB.document as IPersistStreamInit;
s := '';
ss := TStringStream.Create(s);
try
sa := TStreamAdapter.Create(ss, soReference) as IStream;
Result := Succeeded(ps.Save(sa, Bool(True)));
if Result then
ACode.Add(ss.Datastring);
finally
ss.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
ShellWindow: IShellWindows;
WB: IWebbrowser2;
spDisp: IDispatch;
IDoc1: IHTMLDocument2;
k: Integer;
begin
ShellWindow := CoShellWindows.Create;
// get the running instance of Internet Explorer
for k := 0 to ShellWindow.Count do
begin
spDisp := ShellWindow.Item(k);
if spDisp = nil then
Continue;
// QueryInterface determines if an interface can be used with an object
spDisp.QueryInterface(iWebBrowser2, WB);
if WB <> nil then
begin
WB.Document.QueryInterface(IHTMLDocument2, iDoc1);
if iDoc1 <> nil then
begin
WB := ShellWindow.Item(k) as IWebbrowser2;
begin
// Add HTML Code to Memo
Memo1.Lines.Add('****************************************');
Memo1.Lines.Add(WB.LocationURL);
Memo1.Lines.Add('****************************************');
GetHTMLCode(WB, Memo1.Lines);
end;
end;
end;
end;
end;

Get the resolution (in DPI) of a *.jpg image

Problem/Question/Abstract:

How to get the resolution (in DPI) of a *.jpg image

Answer:

procedure GetResJpg(JPGFile: string);
const
BufferSize = 50;
var
Buffer: string;
Index: integer;
FileStream: TFileStream;
HorzRes, VertRes: Word;
DP: Byte;
Measure: string;
begin
FileStream := TFileStream.Create(JPGFile, fmOpenReadWrite);
try
SetLength(Buffer, BufferSize);
FileStream.Read(buffer[1], BufferSize);
Index := Pos('JFIF' + #$00, buffer);
if Index > 0 then
begin
FileStream.Seek(Index + 6, soFromBeginning);
FileStream.Read(DP, 1);
case DP of
1: Measure := 'DPI';
2: Measure := 'DPC';
end;
FileStream.Read(HorzRes, 2);
HorzRes := Swap(HorzRes);
FileStream.Read(VertRes, 2);
VertRes := Swap(VertRes);
end;
finally
FileStream.Free;
end;
end;

Using Case structure with strings

Problem/Question/Abstract:

I am sure every one at some time has wanted to use a case structure with strings but that is not possible with delphi case structures. So this is my solution which I have used over and over...

Answer:

I created a function called string index that returns the index of a string within an array of strings.  The function returns -1 if the string was not found and is not case sensitive.

Usage:

Simply use like this

case StringIndex('Edit', ['Post', 'Edit', 'Cancel']) of
0: ; // Do somthing for Post "command"
1: ; // Do somthing for Edit "command"
2: ; // Do somthing for Cancel "command"
end;
{. }
{. }
{. }
or

if StringIndex('Edit', ['a', 'ab', 'rth']) = -1 then
// something
else
// something

StringIndex returns -1 if the string does not exist. This function is not case sensitive.

Of course the first string 'Edit' would be some variable.

Happy Coding!

Source:

unit Fn_StringIndex;

interface
uses
SysUtils;

function StringIndex(const SearchString: string; StrList: array of string): Integer;

implementation

function StringIndex(const SearchString: string; StrList: array of string): Integer;
var
I: Integer;
begin
Result := -1;
for I := 0 to High(StrList) do
if CompareText(SearchString, StrList[I]) = 0 then
begin
Result := I;
Break;
end;
end;

end.

SOME EXAMPLES OF USAGE

I decided it would be good for me to show all the places where I have used this function, so it is clearer the purpose I made it.

These are cuts directly from live code.

I hope this helps and maybe spark some ideas.

In this case I used it to determine my action if the OrdProp was Boolean or WordBool

EnumVal := GetOrdProp(Instance, PropInfo);
if StringIndex(PropInfo^.PropType^^.Name, ['Boolean', 'WordBool']) <> -1 then
begin
{ ... }
// to much to explain here
{ ... }
end
else
{ ... }

Here I am determining what kind of text to return based on the float type name

tkFloat: case StringIndex(Info.PropInfo^.PropType^^.Name,
['Currency', 'TDateTime']) of
0:
begin
Result := CurrToStr(GetFloatProp(Instance, PropInfo));
end;
1: Result := DateTimeToStr(GetFloatProp(Instance, PropInfo));
else
Result := FloatToStr(GetFloatProp(Instance, PropInfo));
end;

This converts a text string S to a boolean value.

function TRTTIModifier.TextToBool(S: string): Boolean;
begin
Result := StringIndex(S, ['', 'F', 'False', '0', 'No']) = -1;
end;

Taken from a web server application, to replace the passed tag "TagString" with whatever its suppose to.  This I think would be a must for anyone using borlands web server architech.

procedure TSite.StateHTMLTag(Sender: TObject; Tag: TTag;
const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
case StringIndex(TagString,
['UserID', 'UserCreationDate', 'UserSiteAccessTime', 'APPCreationDate',
'UserList', 'Host'])
of
0: ReplaceText := IntToStr(User.ID);
1: ReplaceText := DateTimeToStr(User.CreationDateTime);
2: ReplaceText := DateTimeToStr(User.LastUserAccess);
3: ReplaceText := DateTimeToStr(App.CreationDateTime) + ' RefCount=' +
IntToStr(App.ReferenceCount);
4: ReplaceText := 'User List has been disabled';
5: ReplaceText := App.Host;
end;
end;

Another snip from a web server app where the command was passed on the url. I am only giving a small snip of it, but I think you get the idea.

else
case StringIndex(Command,
['EDITOBJECT', 'MODIFY', 'GENFORM', 'DELETE',
'PREVIEW', 'EDIT', 'CREATESITE', 'Reload',
'CreateSubSite', 'LogOut', 'HistoryBack', 'HistoryForward',
'PublishSite', 'Copy']) of
0:
begin
Response.Content := EditObject(PassedObject, SubCommand);
end;
1:
begin

This is taken from a some laser controler software I wrote.... You can see that I am determining what method to call based on the file extension.

procedure TBoneEditorData.LoadAnyFile(const FileName: string);
var
Ext: string;
begin
Ext := ExtractFileExt(FileName);
case StringIndex(Ext, ['.fmc', '.ild', '.fbz', '.fgp', '.fif']) of
0: LoadMotionFile(FileName);
1: LoadIldaFile(FileName);
2: LoadBonesFile(FileName);
3: LoadCombo(FileName);
4: LoadImageFile(FileName);
else
raise Exception.CreateFmt('Cannot load files of this type extension "%s"', [Ext]);
end;
end;

This takes a code from a database field and converts it to an ord type

function TMDBSchedule.GetFrequency: TFrequency;
const
FreqArray: array[0..4] of string = ('Y', 'M', 'W', 'D', 'N');
var
FreqInput: string;
FreqOrd: integer;

begin
FreqInput := UpperCase(DataSet.FieldByName('Frequency').AsString);

FreqOrd := StringIndex(FreqInput, FreqArray);

case FreqOrd of
0: Result := frYearly;
1: Result := frMonthly;
2: Result := frWeekly;
3: Result := frDaily;
4: Result := frNone;
else
Result := frNone;
end;
end;

Thats all the most important stuff.... have fun!


Component Download: http://www.baltsoft.com/files/dkb/attachment/fn_stringindex.ziphttp://www.baltsoft.com/files/dkb/attachment/fn_stringindex.zip

Ping without raw sockets, Implementing Internet Pings Using Icmp.dll

Problem/Question/Abstract:

Windows supports an Internet Control Message Protocol (ICMP) to determine whether or not a particular host is available. ICMP is a network layer protocol that delivers flow control, error messages, routing, and other data between Internet hosts. ICMP is primarily used by application developers for a network ping.
A ping is the process of sending an echo message to an IP address and reading the reply to verify a connection between TCP/IP hosts.
If you are writing new application will be better to use the Winsock 2 raw sockets support, implemented in Indy, for example.
Please note, however, that for Windows NT and Windows 2000 implementations, Raw Sockets are subject to security checks and are accessible only to members of the administrator's group.
Icmp.dll provides functionality that allows developers to write Internet ping applications on Windows systems without Winsock 2 support.
Note that the Winsock 1.1 WSAStartup function must be called prior to using the functions exposed by ICMP.DLL.
If you do not do this, the first call to IcmpSendEcho will fail with error 10091 (WSASYSNOTREADY).

Answer:

unit Ping;

interface
uses
Windows, SysUtils, Classes;

type
TSunB = packed record
s_b1, s_b2, s_b3, s_b4: byte;
end;

TSunW = packed record
s_w1, s_w2: word;
end;

PIPAddr = ^TIPAddr;
TIPAddr = record
case integer of
0: (S_un_b: TSunB);
1: (S_un_w: TSunW);
2: (S_addr: longword);
end;

IPAddr = TIPAddr;

function IcmpCreateFile: THandle; stdcall; external 'icmp.dll';
function IcmpCloseHandle(icmpHandle: THandle): boolean; stdcall; external 'icmp.dll'
function IcmpSendEcho(IcmpHandle: THandle; DestinationAddress: IPAddr;
RequestData: Pointer; RequestSize: Smallint;
RequestOptions: pointer;
ReplyBuffer: Pointer;
ReplySize: DWORD;
Timeout: DWORD): DWORD; stdcall; external 'icmp.dll';

function Ping(InetAddress: string): boolean;

implementation

uses
WinSock;

function Fetch(var AInput: string; const ADelim: string = ' '; const ADelete: Boolean
= true)
: string;
var
iPos: Integer;
begin
if ADelim = #0 then
begin
// AnsiPos does not work with #0
iPos := Pos(ADelim, AInput);
end
else
begin
iPos := Pos(ADelim, AInput);
end;
if iPos = 0 then
begin
Result := AInput;
if ADelete then
begin
AInput := '';
end;
end
else
begin
result := Copy(AInput, 1, iPos - 1);
if ADelete then
begin
Delete(AInput, 1, iPos + Length(ADelim) - 1);
end;
end;
end;

procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
phe: PHostEnt;
pac: PChar;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
try
phe := GetHostByName(PChar(AIP));
if Assigned(phe) then
begin
pac := phe^.h_addr_list^;
if Assigned(pac) then
begin
with TIPAddr(AInAddr).S_un_b do
begin
s_b1 := Byte(pac[0]);
s_b2 := Byte(pac[1]);
s_b3 := Byte(pac[2]);
s_b4 := Byte(pac[3]);
end;
end
else
begin
raise Exception.Create('Error getting IP from HostName');
end;
end
else
begin
raise Exception.Create('Error getting HostName');
end;
except
FillChar(AInAddr, SizeOf(AInAddr), #0);
end;
WSACleanup;
end;

function Ping(InetAddress: string): boolean;
var
Handle: THandle;
InAddr: IPAddr;
DW: DWORD;
rep: array[1..128] of byte;
begin
result := false;
Handle := IcmpCreateFile;
if Handle = INVALID_HANDLE_VALUE then
Exit;
TranslateStringToTInAddr(InetAddress, InAddr);
DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0);
Result := (DW <> 0);
IcmpCloseHandle(Handle);
end;

end.

new window in WebBrowser

Problem/Question/Abstract:


Answer:
{
Usually when you open a URL in new window in TWebBrowser it opens
the Internet Explorer. This tip creates a new instance of your
browser form and opens the new site in your browser.
}


procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
var
NewWindow: TForm1;
begin
// a new instance of the form will be created
// Eine neue Instanz wird erstellt
NewWindow := TForm1.Create(self);

NewWindow.Show;
ppDisp := NewWindow.Webbrowser1.DefaultDispatch;
end;

Mouse wheel in a DBGrid

Problem/Question/Abstract:

Use the mouse wheel in a DBGrid...

Answer:

Speaking personally, I don't like the use that Dbgrid makes of the mousewheel because it only allows us to move through the visible part of the DBGrid. If we want to move more records downwards or upwards, we simply can't do it by means of the mousewheel and we have to use the vertical scrollbar or the keys. But, don't worry because everything has a solution. We have to do the following: To capture the WM_MOUSEWHEEL message and substitute the present behaviour of the DBGrid when it receives one of these messages for the behaviour we want it to have. All in all, there is a little problem (of course, there is always one) and it is that ... How can we capture the messages directed to the DBGrid?. At a first sight it would seem that it is only possible to do it through a new version of the DBGrid where we could introduce event handlers, wouldn't it?. It is a tedious task to do it, to create a new control, install it, to substitute our DBGrids for that new component... as I said, a too tedious work. Ok you have here something to do it with a simple DBGrid. We will simply change the WndProc of the DBGrid putting there what we want to. For that task we will use a class, let's call it "Comodin" a descendant of Tcontrol (in this invention we will call it TomaInvento).

type
TomaInvento = class(TControl);

So we can, later on, substitute the WndProc of DBGrid1 with an instruction similar to:

DBGrid1.WindowProc := DBGrid1PillaLaRueda;

for example in "Oncreate" of our Form. Here you have the Unit of a form in which I have placed a DBGrid a TTable and a TDataSource to check all the invention.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, DBGrids, Db, DBTables;

type
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure DBGrid1PillaLaRueda(var Message: TMessage);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

type
TomaInvento = class(TControl);

procedure TForm1.DBGrid1PillaLaRueda(var Message: TMessage);
var
Cuanto: short;
begin
if (Message.Msg = WM_MOUSEWHEEL) then
begin
Cuanto := HIWORD(Message.WParam);
Cuanto := Cuanto div 120;
DbGrid1.DataSource.DataSet.MoveBy(-Cuanto)
end
else
TomaInvento(DBGrid1).WndProc(Message);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DBGrid1.WindowProc := DBGrid1PillaLaRueda;
end;

end.

Basically when we move the wheel upwards (as if we moved our finger away) the message gives us a positive value in the HiWord of wParam, and when we move the wheel downwards (moving the finger towards us) we receive a negative value. That value apart from showing the direction of the turning of the wheel it gives us a multiple of 120 depending on how fast we moved the wheel. Those who want to know more about the 120 which appear in the code should read the help on WM_MOUSEWHEEL that you have in the win32.hlp that you should have in your hard disk.

Insert a row into an existing table in a Word document

Problem/Question/Abstract:

I want to add rows to an existing table but have difficulties using InsertRows. Does anyone have an example?

Answer:

uses
ComObj;

procedure TForm1.Button1Click(Sender: TObject);
var
App, WordDoc, tabelle: OLEVariant;
begin
try
{Create MSWord instance}
App := CreateOleObject('Word.Application');
except
{Error...}
Exit;
end;
{Open a Word Document}
WordDoc := App.Documents.Open('c:\test.doc');
{Insert a table}
tabelle := WordDoc.Tables.Add(App.Selection.Range, 5 {Columns}, 4 {Rows});
{Write sth into a cell}
tabelle.Cell(2 {Column}, 4 {Row}).Range.Text := '123';
{Append row to table}
App.Selection.Tables.Item(1).Rows.Item(App.Selection.Tables.Item(1).Rows.Count).Select;
App.Selection.InsertRowsBelow;
{Set Column width}
App.Selection.Tables.Item(1).Columns.Item(1).SetWidth(ColumnWidth := 40,
RulerStyle := $00000000 {wdAdjustNone});
{Show MSWord}
App.Visible := True;
{Cleanup...}
App := Unassigned;
WordDoc := Unassigned;
tabelle := Unassigned;
end;

Work with file security descriptors

Problem/Question/Abstract:

I want to be able to store a file and its security decriptor, then reload it later. I have been able to use GetFileSecurity and GetSecurityDescriptorOwner, but I don't understand how to translate this information into a transportable format, store it in a remote table, then retrieve it and rebuild the correct description?

Answer:

Below is code I have used to convert to a Self Relative SD:

{ ... }
if Assigned(SD) then
begin
  lpdwAbsoluteSecurityDescriptorSize := 0;
  lpdwDaclSize := 0;
  lpdwSaclSize := 0;
  lpdwOwnerSize := 0;
  lpdwPrimaryGroupSize := 0;
  MakeAbsoluteSD(SD,
    AbsoluteSID, lpdwAbsoluteSecurityDescriptorSize,
    pDacl^, lpdwDaclSize,
    pSacl^, lpdwSaclSize,
    pOwner, lpdwOwnerSize,
    pPrimaryGroup, lpdwPrimaryGroupSize);
  GetMem(AbsoluteSID, lpdwAbsoluteSecurityDescriptorSize);
  GetMem(pDacl, lpdwDaclSize);
  GetMem(pSacl, lpdwSaclSize);
  GetMem(pOwner, lpdwOwnerSize);
  GetMem(pPrimaryGroup, lpdwPrimaryGroupSize);
  try
    if not MakeAbsoluteSD(SD, AbsoluteSID, lpdwAbsoluteSecurityDescriptorSize,
      pDacl^, lpdwDaclSize, pSacl^, lpdwSaclSize, pOwner, lpdwOwnerSize,
      pPrimaryGroup, lpdwPrimaryGroupSize) then
      raise Exception.create(LastErrorMessage);
    lpdwBufferLength := 0;
    MakeSelfRelativeSD(AbsoluteSID, RelativeSID, lpdwBufferLength);
    GetMem(RelativeSID, lpdwBufferLength);
    if not MakeSelfRelativeSD(AbsoluteSID, RelativeSID, lpdwBufferLength) then
      raise Exception.create(LastErrorMessage);
  finally
    FreeMem(AbsoluteSID, lpdwAbsoluteSecurityDescriptorSize);
    FreeMem(pSacl, lpdwSaclSize);
    FreeMem(pOwner, lpdwOwnerSize);
    FreeMem(pPrimaryGroup, lpdwPrimaryGroupSize);
  end;
end;
{ ... }

For Windows 2000 and up: Retrieve only those parts of the security descriptor you need to persist through GetFileSecurity, convert it to a string using ConvertSecurityDescriptorToStringSecurityDescriptor. To restore the decriptor use ConvertStringSecurityDescriptorToSecurityDesciptor and SetFileSecurity.

Volume output meter

Problem/Question/Abstract:

Is there a way, like the Windows Volume Control, to get the current
volume output... not the Volume settings (loudness), but how "loud" the
playing sound is? The Volume Control has a "red-to-green" bar that show
the volume output... how could this be done?

Answer:

Here's some code that will retrieve a handle to the meter attached to
the WaveOut source of the speaker line, if there is one:

var
  MixerControl: TMixerControl;
  MixerControlDetails: TMixerControlDetails;
  MixerControlDetailsSigned: TMixerControlDetailsSigned;
  Mixer: THandle;
  MixerLine: TMixerLine;
  MixerLineControls: TMixerLineControls;
  PeakMeter: DWord;
  Rslt: DWord;
  SourceCount: Cardinal;
  WaveOut: DWord;
  I: Integer;
  X: Integer;
  Y: Integer;
begin
  Rslt := mixerOpen(@Mixer, 0, 0, 0, 0);
  if Rslt <> 0 then
    raise Exception.CreateFmt('Can''t open mixer (%d)', [Rslt]);
  FillChar(MixerLine, SizeOf(MixerLine), 0);
  MixerLine.cbStruct := SizeOf(MixerLine);
  MixerLine.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
  Rslt := mixerGetLineInfo(Mixer, @MixerLine,
    MIXER_GETLINEINFOF_COMPONENTTYPE);
  if Rslt <> 0 then
    raise Exception.CreateFmt('Can''t find speaker line (%d)', [Rslt]);
  SourceCount := MixerLine.cConnections;
  WaveOut := $FFFFFFFF;
  for I := 0 to SourceCount - 1 do
  begin
    MixerLine.dwSource := I;
    Rslt := mixerGetLineInfo(Mixer, @MixerLine,
      MIXER_GETLINEINFOF_SOURCE);
    if Rslt <> 0 then
      raise Exception.CreateFmt('Can''t get source line (%d)', [Rslt]);
    if MixerLine.dwComponentType = MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT then
    begin
      WaveOut := MixerLine.dwLineId;
      Break;
    end;
  end;
  if WaveOut = $FFFFFFFF then
    raise Exception.Create('Can''t find wave out device');
  FillChar(MixerLineControls, SizeOf(MixerLineControls), 0);
  with MixerLineControls do
  begin
    cbStruct := SizeOf(MixerLineControls);
    dwLineId := WaveOut;
    dwControlType := MIXERCONTROL_CONTROLTYPE_PEAKMETER;
    cControls := 1;
    cbmxctrl := SizeOf(TMixerControl);
    pamxctrl := @MixerControl;
  end;
  Rslt := mixerGetLineControls(Mixer, @MixerLineControls,
    MIXER_GETLINECONTROLSF_ONEBYTYPE);
  if Rslt <> 0 then
    raise Exception.CreateFmt('Can''t find peak meter control (%d)',
      [Rslt]);
  PeakMeter := MixerControl.dwControlID;

  // at this point, I have the meter control ID, so I can
  // repeatedly query its value and plot the resulting data
  // on a canvas

  X := 0;
  FillChar(MixerControlDetails, SizeOf(MixerControlDetails), 0);
  with MixerControlDetails do
  begin
    cbStruct := SizeOf(MixerControlDetails);
    dwControlId := PeakMeter;
    cChannels := 1;
    cbDetails := SizeOf(MixerControlDetailsSigned);
    paDetails := @MixerControlDetailsSigned;
  end;
  repeat
    Sleep(10);
    Rslt := mixerGetControlDetails(Mixer, @MixerControlDetails,
      MIXER_GETCONTROLDETAILSF_VALUE);
    if Rslt <> 0 then
      raise Exception.CreateFmt('Can''t get control details (%d)',
        [Rslt]);
    Application.ProcessMessages;
    Inc(X);
    Y := 300 - Round(300 * Abs(MixerControlDetailsSigned.lValue) /
      32768);
    with Canvas do
    begin
      MoveTo(X, 0);
      Pen.Color := clBtnFace;
      LineTo(X, 300);
      Pen.Color := clWindowText;
      LineTo(X, Y);
    end;
  until X > 500;

  // don't forget to close the mixer handle when you're done

  Rslt := mixerClose(Mixer);
  if Rslt <> 0 then
    raise Exception.CreateFmt('Can''t close mixer (%d)', [Rslt]);
end;

Using Paradox Tables on CD-ROMS and Other Read-Only Media

Problem/Question/Abstract:

Using Paradox Tables on CD-ROMS and Other Read-Only Media

Answer:

Introduction

You'll notice that Delphi database development leans heavily towards desktop databases; especially towards Paradox databases. Why? Most folks just don't have the need to access server-based databases. Also, Paradox, having been a former Borland product, was and has been the de facto desktop database format for Delphi since Delphi's introduction to the market. I've worked with Paradox since it first came out, and that's over 12 years, and I still prefer it over the likes of Access and dBase and dBase clones. Why? Because there are just too many features in Paradox that I'd be stupid not to use - things that don't exist in the other databases (I won't go into a feature comparison here, because that's beyond the scope of this discussion).

In any case, even though I believe Paradox is by far the best desktop database format around, it isn't without its shortcomings. One of them in particular is the inability to easily use Paradox tables on read-only media such as a CD- ROM or network directory that's set to READONLY. The reason for this is the way Paradox was built to address multi- user database applications. Whenever, you open up a Paradox table, two files are created in the directory where the table resides. These files are called Paradox.LCK and PdoxUsrs.LCK. The first file is the table/record lock file which keeps track of the users accessing the table, and the second file is the directory lock file. On read-only media, these files can't be created - that poses a problem, but not so bad that we can't work around it.

The workaround is this: All the BDE needs to access a Paradox table on read-only media is the PdoxUsrs.LCK file. Why? When it sees this file, it assumes it's already been written, and won't try to write it or the Paradox.LCK file again. It also assumes that the table is read-only, and so it won't bother. So all you have to do is create a PdoxUsrs.LCK file and you're all set. So how do you do that? There are two ways: One easy, one kind of easy. I'll let you decide...

Creating a PDOXUSRS.LCK File

The Easy Way

The easiest way to create a PDOXUSRS.LCK file is to simply open up a table. As soon as you do that, both the Paradox.LCK and PdoxUsrs.LCK files get created in the directory where the table resides. Then, what you want to do is open up either Explorer or File Mangler, and copy the PdoxUsrs.LCK file to another directory. Don't try to move it - you'll get sharing violations. That's it. You now have a dummy PdoxUsrs.LCK file.

The Sort of Easy Way

The other way to create a PDOXUSRS.LCK file involves a bit of BDE coding. Specifically, a call to dbiAcqPersistTableLock.This function takes two arguments: A Database handle, a Table Name (PChar), and the driver type (PChar). What it does is create both the Paradox.LCK file and the PdoxUsrs.LCK file. Pretty slick, huh? I suggest that you download the demo program now so you can follow what's going on in the code below:

procedure TForm1.Button2Click(Sender: TObject);
var
  DBs: TDatabase;
begin
  if (Edit1.Text <> '') then
  begin
    Check(DBIInit(nil));
    DBs := TDatabase.Create(nil);
    with DBs do
    begin
      Params.Add('path=' + Edit1.Text);
      DatabaseName := 'MyLockDB';
      DriverName := 'STANDARD';
      Connected := True;
    end;

    Check(DbiAcqPersistTableLock(Dbs.Handle, 'MyLockTable.DB', 'PARADOX'));
    DbiExit;
    if FileExists(Edit1.Text + '\PDOXUSRS.LCK') then
    begin
      MessageBeep(MB_OK);
      ShowMessage('Lock File was successfully created in ' + #13 + Edit1.Text);
    end
    else
    begin
      MessageBeep(MB_ICONEXCLAMATION);
      MessageDlg('Lock file was not created! Something went wrong!', mtError,
        [mbCancel], 0);
    end;
    Dbs.Free;
  end;
end;

So what did I do? Well, the first thing was that I created a TDatabase. You need that to get a connection into the BDE. Note that I supply a "Path" parameter to the Params property. This will define where I want to place the lock files. And as with most data access components I use, I prefer to create and destroy them on the fly instead of embedding them on a form. There are a couple of reasons for this. First of all, it's good resource management. By creating the object, using it, then immediately destroying it, I make better use available resources than if I loaded everything in memory at once and kept it there until the program ended. Keep that in mind when you're building applications. Now onward!

Once I make the connection to the database, I make the call to DbiAcqPersistTableLock. Notice that I enclose the function within the Check function. Check solves most of the problems of trapping BDE error messages. In the old days before Check, you had to trap error messages yourself which, in many cases, took up several lines of code. In fact, many of my programs written in Delphi 1.0 that used functions that employed BDE calls were mostly error message trapping! Yikes. So a rule of thumb is to enclose all your BDE calls within Check. It'll trap the error messages and pop up an error dialog. Why don't we discuss the parameters of DbiAcqPersistTableLock now?

DbiAcqPersistTableLock takes three parameters. They are described below:

Parameter
Type
Description
hDB
Database Handle
Handle to a valid database. Supply a valid TDatabase handle here, or you can do it the long way with BDE calls (I suggest you don't do this)
pszTableName
PChar
This is the fully qualified file name of a table (Path/Name). But for our purposes, we can submit any name. We just want to create the lock files.
pszDriverType
PChar
This is the name of the type of table driver to be used for creating the lock files. Since what we're doing is Paradox-specific, and for desktop databases, only Paradox is supported, the only driver name you can supply here is 'PARADOX'


Okay, you're now ready to make lock files. As you can see from the code, it's not a difficult thing to do at all. One last thing before I close this discussion. Notice that I make calls to DbiInit and DbiExit in the method. These intialize and close the BDE respectively. Even though they're not necessary to call when using DbiAcqPersistTableLock, I've gotten in the habit of enclosing any code that uses BDE calls within these two function calls just to ensure that I've got a connection to the database engine. It's just an insurance policy. Okay, that's it!

Using InterBase generators for AutoIncrement fields

Problem/Question/Abstract:

Using InterBase generators for AutoIncrement fields

Answer:

InterBase doesn't offer the convenient AutoIncrement datatype as some desktop database systems (MS-Access, Parados) do. In a project I simulated this for a unique index field by using a trigger combined with a generator.

The example below assumes that there is a table CUSTOMER with a uniquely indexed field CUST_HASH.
The generators' name is GEN_CUSTOMER.

The traditional technique would be to detect the current maximum number max and then insert a value of [max+1]:

SELECT MAX(cust_hash) + 1 FROM customer
INSERT INTO customer(...)values(...)

The risk with this approach is that a parallel user could theoretically do the same thing before you write the determined value and end the transaction. The parallel user would try to post the same number and either cause a unique-index violation or post a duplicated value!

The trick with the generator is also faster since you don't have to do the max() query for each insert.

CREATE GENERATOR gen_customer;

set GENERATOR gen_customer to 100;

CREATE TRIGGER customer_autoinc for customer
  BEFORE INSERT as
begin
  if (NEW.cust_hash is NULL) then
    NEW.cust_hash = GEN_ID(gen_customer, 1);
end;