rejetto forum

Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Topics - Mars

Pages: 1 2 3 4 5 ... 8
31
Programmers corner / account password
« on: February 03, 2010, 12:00:20 AM »
more security to allow a user to change his password

Quote
 procedure setAccount();
  var
    a: Paccount;
    s: string;
  begin
  result:='';
  if p > '' then
    a:=getAccount(p, TRUE)
  else
    a:=md.cd.account;
  if a = NIL then exit;
  spaceIf(TRUE);

    try                 //mod by mars
    s:='';
    if a.pwd<>'' then s:=parEx('oldpass');
    if (a.pwd=s) and validUsername(s, TRUE) then

      try
      s:=parEx('password');
      if validUsername(s, TRUE) then
        a.pwd:=s;
      except end;
  except end;

usage:  {.set account|%user%|password=NEWPASSWORD|oldpass=OLDPASSORD.}


Quote
 procedure getterAccount();
  var
    a: Paccount;
    s: string;
  begin
  result:='';
  if p > '' then
    a:=getAccount(p, TRUE)
  else
    a:=md.cd.account;
  if a = NIL then exit;
  s:=lowercase(par(1));
  if s = 'redirect' then result:=a.redir
  else if s = 'has password' then trueIf((a.pwd=par(2)) or (a.pwd=pars[2]))  //add by mars
  else if s = 'no limits' then trueIf(a.nolimits)
  else if s = 'enabled' then trueIf(a.enabled)
  else if s = 'is group' then trueIf(a.group)
  else if s = 'member of' then result:=join(';',a.link)
  else if s = 'notes' then result:=a.notes;
  try result:=getKeyFromString(a.notes, parEx('notes key')) except end;
  end; // getterAccount

usage: {.get account|%user%|has password|PASSWORD.}


Example of application :

<form method=post action="/~selfpasschange>
<table>
  <tr><td align=left>{.!Username.}<td><INPUT READONLY NAME="name" value="%user%">
  <tr><td align=left>{.!Current Password.}<td><input type="password" name="oldpass">
  <tr><td align=left>{.!New Password.}<td><input type="password" name="newpass">
  <tr><td align=left>{.!Confirm Password.}<td><input type="password" name="confirmpass">
  <tr><td align=left><td align=center><input type=submit value="{.!Change.}">
  </tr></table

[selfpasschange]
{.if|{.and|%user%|{.{.postvar|newpass.}={.postvar|confirmpass.}.}/and.}|
  {:{.set account|%user%|oldpass={.postvar|oldpass.}|password={.postvar|newpass.}.}:}
/if.}
{.if|{.get account|%user%|has password|{.postvar|newpass.}.}
  |{:<b>{.!The new password is.} : <INPUT READONLY NAME="name" value="{.postvar|newpass.}"></b>:}
  |<b><font color=firebrick>{.!Error during change password !.}</b>
/if.}

32
Programmers corner / try uniqueStrings(f.accounts[act]) except end;
« on: February 02, 2010, 10:45:45 PM »
one other forget from rejetto

Quote
  for act:=low(act) to high(act) do
    begin
    try f.accounts[act]:=get('') except end;
    try addUniqueArray(f.accounts[act], get('add ')) except end;
    try removeArray(f.accounts[act], get('remove ')) except end;
    try uniqueStrings(f.accounts[act]) except end;  //add by mars
    end;
  VFSmodified:=TRUE;
  mainfrm.filesBox.repaint();
  end; // setItem

33
Programmers corner / f.accounts:=folder.accounts;
« on: February 02, 2010, 10:41:12 PM »
was missing when inserting files from disk to the listing:

Quote
        f.size:=0;
        if f.isFile() then
          f.size:=sr.FindData.nFileSizeLow
            +int64(sr.FindData.nFileSizeHigh) shl 32;
        f.mtime:=filetimeToDatetime(sr.FindData.ftLastWriteTime);
        f.accounts:=folder.accounts;         //add by mars
        addToListing(f);
        until (findNext(sr) <> 0) or (conn.state = HCS_DISCONNECTED) or (limit >= 0) and (actualCount >= limit);
    finally findClose(sr) end;
  finally comments.free  end
  end; // includeFilesFromDisk


34
Programmers corner / SB_EXT
« on: February 02, 2010, 10:21:34 PM »
Another aberration concerns the sorting by extension of files, at present the names of directories are considered as names of classic files with an extension, while they should be considered names without extension.

you have to unselect 'folder before' in the menu

solution:
Quote
 case sortby of
    SB_SIZE: result:=compare_(f1.size, f2.size);
    SB_TIME: result:=-compare_(f1.mtime, f2.mtime);
    SB_DL: result:=-compare_(f1.DLcount, f2.DLcount);
    SB_EXT: begin
            if not (f1.isfolder or f2.isfolder) then result:=compareExt(f1.name, f2.name)             // two files or links  --> sort by ext
            else if (f1.isfolder and f2.isfolder) then result:=ansiCompareText(f1.name, f2.name)   // two folders  --> sort by name
            else if f2.isfolder then result:=1    // sort as without extension
            else result:=-1;
            end;

    SB_COMMENT: result:=ansiCompareText(f1.comment, f2.comment);
    else result:=0;
    end;

35
Programmers corner / inherited flags
« on: February 02, 2010, 06:57:12 PM »
Quote
procedure TmainFrm.appEventsShowHint
  ...
  s:=flag('Invisible', FA_HIDDENTREE, TRUE);
  if s = '' then s:=flag('Invisible', FA_HIDDEN);
  result:=result+s
    +flag('Download forbidden', FA_DL_FORBIDDEN)
    +flagR('Don''t log', FA_DONT_LOG);

'Invisible' and 'Download forbidden' are inherited flags

Quote
procedure TmainFrm.appEventsShowHint
  ...
  s:=flagR('Invisible', FA_HIDDENTREE, TRUE);
  if s = '' then s:=flag('Invisible', FA_HIDDEN);
  result:=result+s
    +flagR('Download forbidden', FA_DL_FORBIDDEN)
    +flagR('Don''t log', FA_DONT_LOG);


36
Programmers corner / broken links
« on: February 02, 2010, 06:51:56 PM »
I tried for a long time how to bring to light the elements of the vfs which could become inaccessible. Here is a rather elegant solution the joined image of which lets augur of the obtained result.

I shall not put this comment in the vote, but this addition will largely be appreciated in the future versions of hfs  
Ami rejetto, il n'y a plus qu'à effectuer un copier-coller.  ;)

Quote from: main.pas
 ICON_EASY = 29;
  ICON_EXPERT = 35;
  ICON_STOP = 11;            // mars (brocken resource)
  ICON_EXCLAMATION = 9;      // mars (brocken resource)
  USER_ICON_MASKS_OFS = 10000;
.......

  function fileHint():string;
  ...
  begin
  result:=if_(HintsfornewcomersChk.checked,'Drag your files here');
  f:=pointedFile();
  if f = NIL then exit;
  parent:=f.parent;
 //(start of brocken resource)
 result:='';
  if f.node.StateIndex=ICON_EXCLAMATION then
  result:=result
   +'********************************************'#13
   +'* PATH NOT FOUND FOR THIS ITEM *'#13
   +'********************************************'#13;

 //(end of brocken resource)
  result:=result+'URL: '+f.url()                        // mars(brocken resource)
    +if_(f.isRealFolder() or f.isFile(), #13'Path: '+f.resource);
  if f.isFile() then
    result:=result+format(#13'Size: %s'#13'Downloads: %d',
      [ smartsize(sizeofFile(f.resource)), f.DLcount ]);
.......

procedure TmainFrm.filesBoxCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  f: Tfile;
  a: TStringDynArray;
  onlyAnon: boolean;
  s: string;   //mars (brocken resource)
begin
if not sender.visible then exit;
f:=Tfile(node.data);
if f = NIL then exit;
if f.hasRecursive([FA_HIDDEN, FA_HIDDENTREE], TRUE) then
   with sender.Canvas.Font do
     style:=style+[fsItalic];
a:=f.accounts[FA_ACCESS];
onlyAnon:= onlyString(USER_ANONYMOUS, a);
//(start of brocken resource)
if f.islink then
  begin         //search if link has a local resource        
  s:=xtpl(lowercase(f.resource),['%host%','127.0.0.1','localhost','127.0.0.1']);
  if pos('127.0.0.1',s)>0 then
    chop('127.0.0.1',s);
  if (s>'') and (s[1]=':') then
    s:='/'+chop('/',s);
  end;
if (f.isLink and (s>'') and (s[1]='/') and (findFilebyURL(s)=NIL))
  or (f.isrealFolder and not directoryexists(f.resource))
  or (f.isFile and not fileexists(f.resource)) then
  begin
  node.StateIndex:=ICON_EXCLAMATION;  
  with sender.Canvas.Font do
    begin
    style:=style+[fsBold,fsItalic];
    color:=clTeal;
    end;
  end
else
//(end of brocken resource)
  if (f.user > '') or (assigned(a) and not onlyAnon) then node.StateIndex:=ICON_LOCK
else node.StateIndex:=-1;
end;

37
Programmers corner / SPECIAL MARS : BEFORE Testing Build 254
« on: February 02, 2010, 05:43:26 PM »
one bug with the macro {.after the list|{:    :}.}

Quote
    if name = 'after the list' then
      if md.afterTheList then
        result:=macroDequote(p)
      else
        result:=MARKER_OPEN+fullMacro+MARKER_CLOSE;

an example to use it  in the default template, section [+file]

Quote
[+file]
<div class='comment'>Index={.inc|nb.%item-ext%.} {.^nb.%item-ext%.} / {.after the list|{:{.^nb.%item-ext%.}:}.} of *.%item-ext%</div>
<td align='right'>%item-size%<td align='right'>%item-modified%<td align='right'>%item-dl-count%

38
Programmers corner / the hfs code is not complete
« on: October 15, 2009, 01:55:22 PM »
in main.pas

Quote
 objects[add('ini='+currentCFG)]:=currentCFGhashed;
  o:=space.objects;

 ... and any more lines

BUT?
Quote
classes.pas
    property Objects[Index: Integer]: TObject read GetObject write PutObject;

function TStrings.GetObject(Index: Integer): TObject;
begin
  Result := nil;
end;

procedure TStrings.PutObject(Index: Integer; AObject: TObject);
begin
end;

I indeed have the impression that there is an unfinished work somewhere.  :D

in the build 248?  ;)

39
HFS ~ HTTP File Server / getUploadDestinationFileName
« on: October 06, 2009, 09:34:11 PM »
procedure getUploadDestinationFileName();
  var
    i: integer;
    fn, ext, s: string;
  begin
  new(data.f);
  fn:=data.uploadSrc;

  data.uploadDest:=f.resource+'\'+fn;
  assignFile(data.f^, data.uploadDest );

  // see if an event script wants to change the name
  s:=eventToFilename('upload name', []);

  if validFilepath(s) then // is it valid anyway?
    begin
    if pos('\', s) = 0 then  // it's just the file name, no path specified: must include the path of the current folder
      s:=f.resource+'\'+s;
    // ok, we'll use this new name
    data.uploadDest:=s;
    fn:=extractFileName(s);
// one "assignFile(data.f^, data.uploadDest);" was missing here
    end;

  if not numberFilesOnUploadChk.checked then exit;
    begin
    ext:=extractFileExt(fn);
    setLength(fn, length(fn)-length(ext));
    i:=0;
    while fileExists(data.uploadDest) do
      begin
      inc(i);
      data.uploadDest:=format('%s\%s (%d)%s', [f.resource, fn, i, ext]);
      end;
    end;
  assignFile(data.f^, data.uploadDest);
  end; // getUploadDestinationFileName

40
Programmers corner / FACTORY_IP_SERVICES
« on: October 01, 2009, 06:03:03 PM »
found this url to get our ip
 
http://www.jonthompson.info/getip.php

41
Programmers corner / Abnormality with special:begin
« on: September 25, 2009, 09:36:13 AM »
this update is necessary to prevent a bug with getpage()

inside the section [special:begin] it is possible to add some text which is include to the web page

[special:begin]
this line will be displayed on the browser
....

*****************************************************************************
procedure Tmainfrm.getPage(sectionName:string; data:TconnData; f:Tfile=NIL; tpl2use:Ttpl=NIL);
....
  data.conn.reply.mode:=HRM_REPLY;
  if sectionName = 'ban' then data.conn.reply.mode:=HRM_DENY;
  if sectionName = 'deny' then data.conn.reply.mode:=HRM_DENY;
  if sectionName = 'not found' then data.conn.reply.mode:=HRM_NOT_FOUND;
  if sectionName = 'unauthorized' then data.conn.reply.mode:=HRM_UNAUTHORIZED;
  if sectionName = 'overload' then data.conn.reply.mode:=HRM_OVERLOAD;
  if sectionName = 'max contemp downloads' then data.conn.reply.mode:=HRM_OVERLOAD;

  md.cd:=data;
  md.tpl:=tpl2use;
  md.folder:=f;
  md.f:=NIL;
  md.archiveAvailable:=FALSE;

 section:=tpl2use.getSection(sectionName);
  if section = NIL then exit;

  s:=tpl2use['special:begin'];
  tryApplyMacrosAndSymbols(s, md, FALSE);

  s:=trim(s)+section.txt;


  if data.conn.reply.mode <> HRM_REPLY then
    s:=xtpl(tpl2use['error-page'], ['%content%', section.txt]);  // in error page do not include the special:begin text

  tryApplyMacrosAndSymbols(s, md);

  data.conn.reply.body:=xtpl(s, [
    '\n', CRLF,
    '%build-time%', floatToStrF((now()-buildTime)*SECONDS, ffFixed, 7,3)
  ]);
  if section.nolog then data.dontLog:=TRUE;
  compressReply(data);
finally
  if not externalTpl then
    tpl2use.free
  end
end; // getPage


42
HFS ~ HTTP File Server / Dynamic DNS, which provider do you use with HFS?
« on: September 24, 2009, 05:51:13 PM »
Report list from www.dmoz.org.

Comprehensive list providers and an introduction to how it works:
  • ChangeIP.com - Allowing free third-level domains under a provided array of second level names, as well as user-provided second-level domains.
  • CJB.net - URL cloaking and dynamic DNS.
  • ddns.nu - Australian based DDNS provider. Commercial services and free entry level accounts. Remote update clients for many platforms, including Unices and Windows.
  • DHIS.org - Compatible with R3, R4 and R5 clients, and a listing of service providers from around the world.
  • DHS International - Low-Cost dynamic DNS provider allowing static hostnames to be mapped to dynamic IP addresses.
  • DNS Park, LLC. - Web-based domain name management services with forwarding, and redirection.
  • DNSDyn.com - Service provides domain name servers for the DSL, cable or dialup modem user.
  • DNS2Go - Service provides a dynamic IP address the ability to run any kind of server from any Internet connection on any platform, including Windows and Linux.
  • dns.widge - Web based creation and management of DNS services.
  • Domain DNS - Free DNS and forwarding service provided by Baremetal.com.
  • DtDNS - Offers DNS hosting and related services to home users and hosting firms. Free Dynamic hostnames, custom nameserver branding, e-mail forwarding and spooling services.
  • DynamIP.com - The Dynamic IP addressing system with client application, and DNS provider.
  • DynDNS Info - DynDNS FAQ and information.
  • DynDNS.com - Provides DNS hosting services, free dynamic DNS, domain registration, mail services, network monitoring, and web redirection.
  • DynDNS.dk - Free Dynamic IP Hosting with support for Danish, English, German and French languages. Also features IP redirection, Site down messages, URL redirection, and MX records.
  • DynIP - Provides DDNS, allowing you to put the server for your domain name on a dial-up connection.
  • DyNS - Dynamic and static DNS service, domain registrations. Free and premium services.
  • Dynup.net - Dynamic DNS service, provides privacy policy, statistics, and servers listing.
  • Eastwind - Web and email redirection services.
  • EdirDNS.net - provides Free DNS Hosting with US and Europe nameservers.
  • EveryDNS.net - Provide static DNS services as well as many advanced services such as Dynamic DNS resolution, secondary service, AXFR service, and domain2web redirection.
  • GnuDIP Dynamic DNS - Server software for giving Dynamic IP addresses, static domain names.
  • HomePC.org - Offers dynamic subdomains, email and web page forwarding.
  • miniDNS.net - Free domain parking, dynamic DNS, and DNS management.
  • 2MyDNS.com - Offers DNS services, such as Dynamic DNS and Web Redirect.
  • MyServer.org DNS Service - Free Dynamic DNS, sub domains and managed DNS services. Web based update utility. No banner adds or nag-ware, totally free sub-domain service.
  • Nicolas' Internet Services - Offers dynamic DNS, hosting, web mail, and URL forwarding.
  • Nikhilino Online - Dynamic DNS (DYNDNS) service for .com .org .net domains. Client runs on all major operating systems.
  • No-IP - Provider of Dynamic DNS network services and URL redirection. Three packages available.
  • Open Domain Server - Dynamic DNS provider offering multiple free public domains and support for user-supplied domains.
  • PlanetDNS - Run your own web site, mail server, ftp server by associating a domain name of your choice to your currently assigned dynamic IP address. Works with cable, DSL, ISDN or dial-up connections.
  • SolidDNS - Provides Dynamic DNS services and domain registration.
  • StaticCling - Static hostnames for your dynamic IP. Native clients are available for almost any operating system.
  • ThatIP.com - Dynamic DNS service allowing yourname.com or yourname.thatip.com.
  • theBBS.org DynDNS - Bulletin Board Service (BBS) oriented Dynamic DNS provider.
  • Tzolkin Corporation - Features include offline webpage, signon and signoff IP address control, and new change domain and change email functions.
  • Virtual DNS - The Virtual DNS service provides an alias for dynamic IP addresses to a static hostname.
  • yi.org - Gives free domain names for dynamic IP's, for dialup connections on all major operating systems.
  • ZA NiC - Free domains. Service policy, mailing list, and FAQ.
  • ZoneEdit - Simple and free web-based domain manager which allows you to safely administrate DNS, mail and web forwarding.


Please take the time to post, thank you for the information. ;)

43
Programmers corner / bad path error with %item-relative-folder%
« on: September 04, 2009, 10:56:34 PM »
rejetto code:
Quote
 procedure handleItem(f:Tfile);
   ....
  if recur then url:=copy(itemFolder, ofsRelUrl, MAXINT)
  else url:='';

  addArray(md.table, [
    '%item-folder%', itemFolder,

    '%item-relative-folder%', url
  ]);
The text in red is the cause of the bug, its value is determined for another use from a character string the length of which is superior to the necessary real value. The chaine of origin contains characters codified under the shape %xx, where from an overestimation of the variable

The following solution requires least resources and gives a correct result.

sometime the var %folder% is not defined for events then i introduce the var %item-base-folder% which give the same result

main.pas
Quote
function Tmainfrm.getFolderPage(folder:Tfile; conn:ThttpConn; otpl:Tobject):string;
var
...
  md: TmacroData;
  currentFolder:string; //add by mars

  procedure applySequential();
  .....
  procedure handleItem(f:Tfile);
    ...
  if recur then url:=copy(itemfolder, length(currentFolder)+1, MAXINT)      //mod by mars    else url:='';

  addArray(md.table, [
   '%item-folder%', macroquote(itemFolder),      //mod by mars
    '%item-base-folder%', macroquote(currentFolder),          //add by mars
    '%item-relative-folder%', macroquote(url)     //mod by mars

  ]);
...
      url:=s
      end
    else
      begin
      if recur then
        s:=copy(f.url(fullEncode), ofsRelUrl, MAXINT)+fingerprint
      else
        s:=f.relativeURL(fullEncode)+fingerprint;
      url:=baseurl+s;
      end;
  addArray(md.table, [
    '%item-url%', macroQuote(s),
    '%item-full-url%', macroQuote(url)
  ]);

  // select appropriate template
...
var
  i: integer;
begin
...
  ofsRelUrl:=length(folder.url(fullEncode))+1;  //create the error when full encode is true
...
  hasher:=Thasher.create();
  hasher.loadFrom(folder.resource);
  try
    if recur then currentFolder:=optUTF8(diffTpl, folder.getFolder()+if_(not folder.isRoot,folder.name+'/'));  //add by mars
    listing.fromFolder( folder, conn, recur );
    if not recur or (otpl <> filelistTpl) then
      listing.sort(conn, diffTpl['sort by']);
....
end; // getFolderPage

usage: http://127.0.0.1/......./?recursive

[folder=file=link]
<tr><td>
%item-name%
<p>%item-folder%
<p>%folder%
<p>%item-relative-folder%



44
Programmers corner / macro rename little bug
« on: September 04, 2009, 09:59:21 PM »
main.pas
Quote
   if name = 'rename' then
      if renameFile(p, par(1))
      and not stopOnMacroRename then // should we stop recursion?
        try
          // by default, we'll stop after first stacked [on macro rename], but recursive=1 will remove this limit
          stopOnMacroRename:=isFalse(par('recursive'));
          runEventScript('on macro rename', toSA(['%old-name%',p,'%new-name%',par(1)]));
          spaceIf(TRUE);
        finally
          stopOnMacroRename:=FALSE;
        end
      else result:=''// add by mars

Else ....when a rename failed, the macro is replaced by <div class=macroerror>macro error: ' ...

45
Programmers corner / macro mkdir with overwrite option
« on: September 04, 2009, 09:50:45 PM »
utilib.pas
Quote

function newMtime(fn:string; var previous:Tdatetime):boolean;
function dirCrossing(s:string):boolean;
function forceDirectory(path:string;overwrite:boolean=FALSE):boolean; //mod by mars
function moveToBin(fn:string; force:boolean=FALSE):boolean;
function uri2disk(url:string; root:Tfile=NIL):string;

......
implementation
....
function forceDirectory(path:string;overwrite:boolean=FALSE):boolean;  //mod by mars
var
  s: string;
begin
result:=TRUE;
path:=excludeTrailingPathDelimiter(path);
if path = '' then exit;
try
  if overwrite then movetobin(path,TRUE); //add by mars
except end;

if directoryExists(path) then exit;
s:=ExtractFilePath(path);
forceDirectory(s);
result:=CreateDir(path);
end; // forceDirectory

main.pas
Quote
   if name = 'mkdir' then
      spaceIf(forceDirectory(uri2diskMaybeFolder(p),isTrue(par('overwrite'))));   //mod by mars

with this update , you can overwrite an existing folder by moving it to the recycled bin , you lose nothing and if it is necessary you can recover it :)

usage: {.mkdir|foldername|overwrite=true.}

Pages: 1 2 3 4 5 ... 8