Tag: delphi

{returns an integer value (0 to 100) rating the key quality}
function PasswordQuality(const strPassword: string): Integer;
var
  i, j, intLen: Integer;
  QC: Double;
  boolUpper, boolLower: Boolean;
begin
  Result := 0;

  intLen := Length(strPassword);
  QC := 4*intLen;

  {at least 5 characters in password required}
  if (intLen > 4) then
  begin
    {check for repetitions (abcabc, aaaaa, 121212, etc}
    for i := 1 to (intLen div 2) do
    begin
      j := i+1;
      while (j <= intLen ) do
      begin
        if (Copy(strPassword, 1, i) = Copy(strPassword, j, i)) then exit;
        Inc(j, i);
      end
    end;

    {check the upper/lower cases}
    boolUpper := False;
    boolLower := False;
    for i := 1 to intLen do
    begin
      if (strPassword[i] in [‘A’..’Z’]) then
        boolUpper := True;
      if (strPassword[i] in [‘a’..’z’]) then
        boolLower := True;
    end;
    if boolUpper and boolLower then
      QC := 1.5*QC;

    {check the numbers}
    for i := 1 to intLen do
    begin
      if (strPassword[i] in [‘0’..’9′]) then
        if (boolUpper or boolLower) then
          QC := 1.5*QC;
    end;

    {check the signs}
    for i := 1 to intLen do
    begin
      if (strPassword[i] < ‘0’) or (strPassword[i] > ‘z’) or
         ((strPassword[i] > ‘9’) and (strPassword[i] < ‘A’)) then
        QC := 1.5*QC;
    end;

    if (QC > 100) then
      QC := 100;
    Result := Trunc(QC);
  end;
end;

Sample to use:
  i := PasswordQuality(edPassword.Text);
  lblPWQuality.Caption := IntToStr(i);
  if (i < 30) then
    lblPWQuality.Font.Color := clRed
  else
  if (i < 60) then
    lblPWQuality.Font.Color := clYellow
  else
    lblPWQuality.Font.Color := clWindowText;

Returns true if the file specified is a real CLR type, otherwise false is returned.

function IsDotNetAssembly(const AFileName: string): Boolean;
var
  fs: TFileStream;
  peHeader, peHeaderSignature,
  timestamp, pSymbolTable, noOfSymbol: dWord;
  machine, sections, optionalHeaderSize, characteristics: Word;
  dataDictionaryRVA: array[0..14] of dWord;
  dataDictionarySize: array[0..14] of dWord;
  i: Integer;
begin
  fs := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
  try
    //PE Header starts @ 0x3C (60). Its a 4 byte header.
    fs.Seek($3C, soFromBeginning);
    fs.Read(peHeader, SizeOf(peHeader));
    //Moving to PE Header start location...
    fs.Position := peHeader;
    fs.Read(peHeaderSignature, SizeOf(peHeaderSignature));
    //We can also show all these value, but we will be
    //limiting to the CLI header test.
    fs.Read(machine, SizeOf(machine));
    fs.Read(sections, SizeOf(sections));
    fs.Read(timestamp, SizeOf(timestamp));
    fs.Read(pSymbolTable, SizeOf(pSymbolTable));
    fs.Read(noOfSymbol, SizeOf(noOfSymbol));
    fs.Read(optionalHeaderSize, SizeOf(optionalHeaderSize));
    fs.Read(characteristics, SizeOf(characteristics));

    { Now we are at the end of the PE Header and from here, the
    PE Optional Headers starts...
    To go directly to the datadictionary, we'll increase the
    stream's current position to with 96 (0x60). 96 because,
    28 for Standard fields
    68 for NT-specific fields
    From here DataDictionary starts...and its of total 128 bytes.
    DataDictionay has 16 directories in total,
    doing simple maths 128/16 = 8.
    So each directory is of 8 bytes.

    In this 8 bytes, 4 bytes is of RVA and 4 bytes of Size.
    btw, the 15th directory consist of CLR header! if its 0,
    it is not a CLR file }

    fs.Seek($60, soFromCurrent);
    for i := 0 to 14 do
    begin
      fs.Read(dataDictionaryRVA[i], SizeOf(dataDictionaryRVA[i]));
      fs.Read(dataDictionarySize[i], SizeOf(dataDictionarySize[i]));
    end;
  finally
    fs.Free
  end;
  Result := (dataDictionaryRVA[14] <> 0)
end;

Created in Delphi from http://www.codeproject.com/KB/cs/AutoDiagrammer.aspx

function TranslateCharsetInfo(lpSrc: integer;
  var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall;
  external ‘gdi32.dll’ name ‘TranslateCharsetInfo’;

function GetDefaultCharset: TFontCharset;
var
  dwCodePage: dWord;
  CharSetInfo: TCharSetInfo;
begin
  {get default codepage}
  dwCodePage := StrToIntDef(GetLocaleStr(GetUserDefaultLCID, LOCALE_IDEFAULTANSICODEPAGE, ”), 0);
  if dwCodePage = 0 then
    dwCodePage := StrToIntDef(GetLocaleStr(GetSystemDefaultLCID, LOCALE_IDEFAULTANSICODEPAGE, ”), GetACP());
  {convert codepage into charset}
  if TranslateCharsetInfo(dwCodePage, CharSetInfo, TCI_SRCCODEPAGE) then
    Result := CharSetInfo.ciCharset
  else
    Result := 0
end;